--- /dev/null
+** Gnus changes.
+
+*** The Gnus alpha distribution no longer bundles Custom and Widget.
+If your Emacs doesn't come with these libraries, fetch them from
+<URL:http://www.dina.kvl.dk/~abraham/custom/>. You also then need to
+add the following to the lisp/dgnushack.el file:
+
+ (push "~/lisp/custom" load-path)
+
+Modify to suit your needs.
+
+*** New functionality for using Gnus as an offline newsreader has been
+added. A plethora of new commands and modes have been added. See the
+Gnus manual for the full story.
+
+*** The nndraft backend has returned, but works differently than
+before. All Message buffers are now also articles in the nndraft
+group, which is created automatically.
+
+*** `gnus-alter-header-function' can now be used to alter header
+values.
+
+*** `gnus-summary-goto-article' now accept Message-ID's.
+
+*** A new Message command for deleting text in the body of a message
+outside the region: `C-c C-v'.
+
+*** You can now post to component group in nnvirtual groups with
+`C-u C-c C-c'.
+
+*** `nntp-rlogin-program' -- new variable to ease customization.
+
+*** `C-u C-c C-c' in `gnus-article-edit-mode' will now inhibit
+re-highlighting of the article buffer.
+
+*** New element in `gnus-boring-article-headers' -- `long-to'.
+
+*** `M-i' symbolic prefix command. See the section "Symbolic
+Prefixes" in the Gnus manual for details.
+
+*** `L' and `I' in the summary buffer now take the symbolic prefix
+`a' to add the score rule to the "all.SCORE" file.
+
+*** `gnus-simplify-subject-functions' variable to allow greater
+control over simplification.
+
+*** `A T' -- new command for fetching the current thread.
+
+*** `/ T' -- new command for including the current thread in the
+limit.
+
+*** `M-RET' is a new Message command for breaking cited text.
+
--- /dev/null
+EMACS=emacs
+XEMACS=xemacs
+
+all: lick info
+
+lick:
+ cd lisp; $(MAKE) EMACS=$(EMACS) all
+
+# Rule for Lars and nobody else.
+some:
+ cd lisp; $(MAKE) EMACS=$(EMACS) some
+l:
+ cd lisp; $(MAKE) EMACS=$(EMACS) clever
+
+info:
+ cd texi; $(MAKE) EMACS=$(EMACS) all
+
+clean:
+ rm -f */*.orig */*.rej *.orig *.rej
+
+xsome:
+ cd lisp; $(MAKE) EMACS=$(XEMACS) some
+
+elclean:
+ rm lisp/*.elc
+
+x:
+ make EMACS=xemacs
+
+distclean:
+ make clean
+ rm -r *~
+ for i in lisp texi; do (cd $$i; make distclean); done
+
+osome:
+ make EMACS=emacs-19.34 some
--- /dev/null
+From lars Thu Feb 23 23:20:38 1995
+From: larsi@ifi.uio.no (ding)
+Date: Fri Feb 24 13:40:45 1995
+Subject: So you want to use the new Gnus
+Message-ID: <lars-doc1@eyesore.no>
+
+Actually, since you are reading this, chances are you are already
+using the new Gnus. Congratulations.
+
+This entire newsgroup you are reading is, in fact, no real newsgroup
+at all, in the traditional sense. It is an example of one of the
+"foreign" select methods that Gnus may use.
+
+The text you are now reading is stored in the "etc" directory with the
+rest of the Emacs sources. You are using the "nndoc" backend for
+accessing it. Scary, isn't it?
+
+This isn't the real documentation. `M-x info', `m gnus <RET>' to read
+that. This "newsgroup" is intended as a kinder, gentler way of getting
+people started.
+
+Gnus is a rewrite of GNUS 4.1, written by Masanobu Umeda. The rewrite
+was done by moi, yours truly, your humble servant, Lars Magne
+Ingebrigtsen. If you have a WWW browser, you can investigate to your
+heart's delight at <URL:http://www.ifi.uio.no/~larsi/larsi.html>.
+
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+From lars Thu Feb 23 23:20:38 1995
+From: larsi@ifi.uio.no (ding)
+Date: Fri Feb 24 13:40:45 1995
+Subject: Starting up
+Message-ID: <lars-doc2@eyesore.no>
+
+If you are having problems with Gnus not finding your server, you have
+to set `gnus-select-method'. A "method" is a way of specifying *how*
+the news is to be found, and from *where*.
+
+Say you want to read news from you local, friendly nntp server
+"news.my.local.server".
+
+(setq gnus-select-method '(nntp "news.my.local.server"))
+
+Quite easy, huh?
+
+From the news spool:
+
+(setq gnus-select-method '(nnspool ""))
+
+From your mh-e spool:
+
+(setq gnus-select-method '(nnmh ""))
+
+There's a whole bunch of other methods for reading mail and news, see
+the "Foreign groups" article for that.
+
+
+From lars Thu Feb 23 23:20:38 1995
+From: larsi@ifi.uio.no (ding)
+Date: Fri Feb 24 13:40:45 1995
+Subject: Where are all the groups, then?
+Message-ID: <lars-doc3@eyesore.no>
+
+If this is the first time you have used a newsreader, you won't have a
+.newsrc file. This means that Gnus will think that all the newsgroups
+on the server are "new", and kill them all.
+
+If you have a .newsrc file, the new groups will be processed with the
+function in the `gnus-subscribe-newsgroup-method' variable, which is
+`gnus-subscribe-zombies' by default.
+
+This means that all the groups have been made into "zombies" - not
+quite dead, but not exactly alive, either.
+
+Jump back to the *Group* buffer, and type `A z' to list all the zombie
+groups. Look though the list, and subscribe to the groups you want to
+read by pressing `u' on the one you think look interesting.
+
+If all the groups have been killed, type `A k' to list all the killed
+groups. Subscribe to them the same way.
+
+When you are satisfied, press `S z' to kill all the zombie groups.
+
+Now you should have a nice list of all groups you are interested in.
+
+(If you later want to subscribe to more groups, press `A k' to
+list all the kill groups, and repeat. You can also type `U' and be
+prompted for groups to subscribe to.)
+
+
+From lars Thu Feb 23 23:20:38 1995
+From: larsi@ifi.uio.no (ding)
+Date: Fri Feb 24 13:40:45 1995
+Subject: I want to read my mail!
+Message-ID: <lars-doc4@eyesore.no>
+
+Yes, Virginia, you can read mail with Gnus.
+
+First you have to decide which mail backend you want to use. You have
+nnml, which is a one-file-one-mail backend, which is quite nice, but
+apt to make your systems administrator go crazy and come after you
+with a shotgun.
+
+nnmbox uses a Unix mail box to store mail. Nice, but slow.
+
+nnmh uses mh-e folders, which is also a one-file-one-mail thingie, but
+slower than nnml. (It doesn't support NOV files.)
+
+So if you want to go with nnmbox, you can simply say:
+
+(setq gnus-secondary-select-methods '((nnmbox "")))
+
+(The same for the other methods, kind of.)
+
+You should also set `nnmail-split-methods' to something sensible:
+
+(setq nnmail-split-methods
+ '(("mail.junk" "From:.*Lars")
+ ("mail.misc "")))
+
+This will put all mail from me in you junk mail group, and the rest in
+"mail.misc".
+
+These groups will be subscribe the same way as the normal groups, so
+you will probably find them among the zombie groups after you set
+these variables and re-start Gnus.
+
+
+From lars Thu Feb 23 23:20:38 1995
+From: larsi@ifi.uio.no (ding)
+Date: Fri Feb 24 13:40:45 1995
+Subject: Foreign newsgroups
+Message-ID: <lars-doc5@eyesore.no>
+
+These are groups that do not come from `gnus-select-method'.
+
+Say you want to read "alt.furniture.couches" from "news.funet.fi". You
+can then either type `B news.funet.fi <RET>' to browse that server and
+subscribe to that group, or you can type
+`G m alt.furniture.couches<RET>nntp<RET>news.funet.fi<RET>', if you
+like to type a lot.
+
+If you want to read a directory as a newsgroup, you can create an
+nndir group, much the same way. There's a shorthand for that,
+though. If, for instance, you want to read the (ding) list archives,
+you could type `G d /ftp <RET>'.
+
+There's lots more to know about foreign groups, but you have to read
+the info pages to find out more.
+
+
+From lars Thu Feb 23 23:20:38 1995
+From: larsi@ifi.uio.no (ding)
+Date: Fri Feb 24 13:40:45 1995
+Subject: Low level changes in GNUS, or, Wrong type argument: stringp, nil
+Message-ID: <lars-doc6@eyesore.no>
+
+Gnus really isn't GNUS, even though it looks like it. If you scrape
+the surface, you'll find that most things have changed.
+
+This means that old code that relies on GNUS internals will fail.
+
+In particular, `gnus-newsrc-hashtb', `gnus-newsrc-assoc',
+`gnus-killed-list', the `nntp-header-' macros and the display formats
+have all changed. If you have some code lying around that depend on
+these, or change these, you'll have to re-write your code.
+
+Old hilit19 code does not work at all. In fact, you should probably
+remove all hilit code from all the Gnus hooks
+(`gnus-group-prepare-hook', `gnus-summary-prepare-hook' and
+`gnus-summary-article-hook'). (Well, at the very least the first
+two.) Gnus provides various integrated functions for highlighting,
+which are both faster and more accurated.
+
+There is absolutely no chance, whatsoever, of getting Gnus to work
+with Emacs 18. It won't even work on Emacsen older than Emacs
+19.30/XEmacs 19.13. Upgrade your Emacs or die.
+
+
+From lars Thu Feb 23 23:20:38 1995
+From: larsi@ifi.uio.no (ding)
+Date: Fri Feb 24 13:40:45 1995
+Subject: How do I re-scan my mail groups?
+Message-ID: <lars-doc8@eyesore.no>
+
+Reading the active file from the nntp server is a drag.
+
+Just press `M-g' on the mail groups, and they will be re-scanned.
+
+You can also re-scan all the mail groups by putting them on level 1
+(`S l 1'), and saying `1 g' to re-scan all level 1 groups.
+
+
+From lars Thu Feb 23 23:20:38 1995
+From: larsi@ifi.uio.no (ding)
+Date: Fri Feb 24 13:40:45 1995
+Subject: How do I set up virtual newsgroups?
+Message-ID: <lars-doc9@eyesore.no>
+
+Virtual newsgroups are collections of other newsgroups. Why people
+want this is beyond me, but here goes:
+
+Create the group by saying
+
+`M-a my.virtual.newsgroup<RET>nnvirtual<RET>^rec\.aquaria\.*<RET>'
+
+This will create the group "nnvirtual:my.virtual.newsgroup", which
+will collect all articles from all the groups in the "rec.aquaria"
+hierarchy.
+
+If you want to edit the regular expression, just type `M-e' on the
+group line.
+
+Note that all the groups that are part of the virtual group have to be
+alive. This means that the cannot, absolutely not, be zombie or
+killed. They can be unsubscribed; that's no problem.
+
+You can combine groups from different servers in the same virtual
+newsgroup, something that may actually be useful. Say you have the
+group "comp.headers" on the server "news.server.no" and the same group
+on "news.server.edu". If people have posted articles with Distribution
+headers that stop propagation of their articles, combining these two
+newsgroups into one virtual newsgroup should give you a better view of
+what's going on.
+
+One caveat, though: The virtual group article numbers from the first
+source group (group A) will always be lower than the article numbers
+from the second (group B). This means that Gnus will believe that
+articles from group A are older than articles from group B. Threading
+will lessen these problems, but it might be a good idea to sort the
+threads over the date of the articles to get a correct feel for the
+flow of the groups:
+
+(setq gnus-thread-sort-functions '(gnus-thread-sort-by-date))
+
+If you only want this in virtual groups, you could say something along
+the lines of:
+
+(setq gnus-select-group-hook
+ (lambda ()
+ (if (eq 'nnvirtual (car (gnus-find-method-for-group
+ gnus-newsgroup-name)))
+ (progn
+ (make-local-variable 'gnus-thread-sort-functions)
+ (setq gnus-thread-sort-functions '(gnus-thread-sort-by-date))))))
+
+
+From lars Thu Feb 23 23:20:38 1995
+From: larsi@ifi.uio.no (ding)
+Date: Fri Feb 24 13:40:45 1995
+Subject: Bugs & stuff
+Message-ID: <lars-doc7@eyesore.no>
+
+If you want to report a bug, please type `M-x gnus-bug'. This will
+give me a precise overview of your Gnus and Emacs version numbers,
+along with a look at all Gnus variables you have changed.
+
+Du not expect a reply back, but your bug should be fixed in the next
+version. If the bug persists, please re-submit your bug report.
+
+When a bug occurs, I need a recipe for how to trigger the bug. You
+have to tell me exactly what you do to uncover the bug, and you should
+(setq debug-on-error t) and send me the backtrace along with the bug
+report.
+
+If I am not able to reproduce the bug, I won't be able to fix it.
+
+I would, of course, prefer that you locate the bug, fix it, and mail
+me the patches, but one can't have everything.
+
+If you have any questions on usage, the "ding@ifi.uio.no" mailing list
+is where to post the questions.
+
+
--- /dev/null
+Sat Sep 13 21:21:38 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.1 is released.
+
+Sat Sep 27 04:32:45 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.11 is released.
+
+Sat Sep 27 03:50:12 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.el (message-send): Post without asking.
+ (message-mode): Modify paragraphs-start and paragraph-separate.
+ (message-newline-and-reformat): New command and keystroke.
+
+Thu Sep 25 00:13:41 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * nnmail.el (nnmail-activate): Init server buffer.
+
+Wed Sep 24 04:11:59 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-draft.el (gnus-draft-setup): Inexplicable binding problem
+ worked around.
+
+ * nnsoup.el (nnsoup-always-save): Renamed.
+
+Wed Sep 24 04:11:02 1997 Nelson Jose dos Santos Ferreira <Nelson.Ferreira@inesc.pt>
+
+ * nnsoup.el (nnsoup-commit-reply-now): New variable.
+ (nnsoup-store-reply): Use it.
+
+Wed Sep 24 02:30:44 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-ems.el (gnus-deactivate-mark): New alias.
+
+Tue Sep 23 07:56:07 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el: Win-away!
+
+ * gnus-msg.el (gnus-setup-message): Don't trust make-symbol.
+
+Tue Sep 23 07:45:11 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.10 is released.
+
+Tue Sep 23 01:41:04 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-sum.el (gnus-read-all-headers): New function.
+ (gnus-select-newsgroup): Use it.
+ (gnus-summary-refer-thread): Ditto.
+ (gnus-refer-thread-limit): New variable.
+ (gnus-summary-refer-thread): Use it.
+
+ * gnus-nocem.el (gnus-nocem-message-wanted-p): New function.
+ (gnus-nocem-check-article): Use it.
+ (gnus-nocem-issuers): Dox ofx.
+
+ * dgnushack.el (dgnushack-compile): Check for cus-edit.
+
+ * message.el (message-included-forward-headers): Include Mime
+ headers.
+ (message-send): Allow posting without confirming from Agent.
+
+Mon Sep 22 05:43:14 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * dgnushack.el (byte-compile-warnings): Don't warn about obsolete
+ variables.
+
+ * gnus-sum.el (gnus-summary-refer-thread): New command and
+ keystroke.
+ (gnus-summary-limit-include-thread): New command and keystroke.
+ (gnus-summary-articles-in-thread): New function.
+ (gnus-articles-in-thread): Renamed.
+
+Sun Sep 21 23:54:50 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.9 is released.
+
+Sun Sep 21 23:38:46 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el (gnus-splash-face): ForestGreen everywhere.
+
+ * gnus-sum.el (gnus-simplify-subject-fully): Use new variable.
+ (gnus-general-simplify-subject): Ditto.
+
+Sun Sep 21 23:34:13 1997 Kurt Swanson <kurt@dna.lth.se>
+
+ * gnus-sum.el (gnus-simplify-subject-functions): New variable.
+ (gnus-simplify-whitespace): New function.
+
+ * gnus-util.el (gnus-map-function): New function.
+
+Sun Sep 21 23:22:04 1997 Michelangelo Grigni <mic@mathcs.emory.edu>
+
+ * gnus-score.el (gnus-score-regexp-bad-p): New function.
+
+Sun Sep 21 00:14:40 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-score.el (gnus-summary-lower-score): Use sym pref.
+ (gnus-summary-increase-score): Use it.
+
+ * gnus.el (gnus-current-prefix-symbol): New variable.
+ (gnus-current-prefix-symbols): New variable.
+
+ * gnus-score.el (gnus-summary-increase-score): Take symbolic
+ prefix.
+
+ * gnus.el (gnus-interactive): Removed.
+ (gnus-interactive): Renamed from gnus-interactive-1.
+ (gnus-symbolic-argument): New command.
+
+ * gnus-draft.el (gnus-draft-send-message): Disable message
+ checks.
+ (gnus-draft-send): Ditto.
+ (gnus-draft-setup): Don't save buffer.
+
+ * dgnushack.el (dgnushack-compile): Warn people about Custom.
+
+ * gnus-group.el (gnus-group-iterate): Use gensymmed variables.
+
+ * pop3.el (pop3-md5): `with-temp-buffer' doesn't exist in Emacs
+ 19.34.
+
+ * nneething.el (nneething-directory): Defvarred.
+
+ * message.el: Autoloaded nndraft things.
+ (message-set-auto-save-file-name): Use it.
+
+ * dgnushack.el (dgnushack-compile): Warn about things.
+
+ * gnus-art.el: Autoload w3-region.
+
+ * gnus-vm.el (gnus-summary-save-in-vm): Simplified.
+
+ * gnus.el: Changed `compiled-function-p' to `byte-code-function-p'
+ throughout.
+
+ * gnus-sum.el (gnus-summary-edit-article): Supply additional
+ param.
+
+ * gnus-group.el (gnus-group-iterate): Undo bogus change.
+
+ * gnus-agent.el (gnus-agentize): Just call gnus-open-agent
+ directly.
+
+ * gnus.el (gnus-interactive): New macro.
+ (gnus-interactive-1): New function.
+
+ * gnus-sum.el (gnus-fetch-old-headers): Allow `invisible'.
+ (gnus-cut-thread): Use it.
+ (gnus-cut-threads): Ditto.
+ (gnus-summary-initial-limit): Ditto.
+ (gnus-summary-limit-children): Ditto.
+
+ * gnus-art.el (gnus-article-edit-done): Accept a prefix arg.
+ (gnus-boring-article-headers): Allow `long-to' param.
+ (article-hide-boring-headers): Use it.
+
+ * gnus-sum.el (gnus-summary-edit-article-done): Accept a
+ no-highlight param.
+
+ * nntp.el (nntp-rlogin-program): New variable.
+ (nntp-open-rlogin): Use it.
+
+ * nnvirtual.el (nnvirtual-request-post): New function.
+
+ * gnus-msg.el (gnus-message-group-art): New variable.
+
+ * gnus-draft.el (gnus-draft-setup): Don't use message-setup.
+
+ * nndraft.el (nndraft): Allow editing articles.
+
+ * gnus-ems.el (gnus-x-splash): Ditto.
+
+ * gnus.el (gnus-splash-face): Darker face.
+
+ * gnus-draft.el (gnus-draft-setup): Clobbered variables.
+
+Sat Sep 20 23:23:49 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.8 is released.
+
+Sat Sep 20 20:41:16 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-start.el (gnus-setup-news-hook): New hook.
+
+ * gnus-agent.el (gnus-agentize): Really set up queue group.
+ (gnus-open-agent): Setup queue here.
+
+Sat Sep 20 20:23:07 1997 Matt Simmons <simmonmt@acm.org>
+
+ * message.el (message-set-auto-save-file-name): Make things work
+ without drafts.
+
+Sat Sep 20 18:32:02 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * nnmh.el (nnmh-request-list-1): Check for links to ".".
+
+ * nndraft.el (nndraft-possibly-change-group): New function.
+
+ * gnus-agent.el (gnus-agent-queue-setup): New function.
+
+Thu Sep 18 04:54:59 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.7 is released.
+
+Thu Sep 18 03:33:54 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-msg.el (gnus-setup-message): Slap a progn around forms.
+
+ * nndraft.el (nndraft-articles): Make sure directory exists.
+
+ * message.el (message-mode): Don't delete article.
+
+ * nnmh.el (nnmh-request-accept-article): Don't save when
+ noinsert.
+
+Wed Sep 17 03:37:59 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * nndraft.el (nndraft-directory): Changed defaults.
+
+ * gnus-agent.el (gnus-agent-fetch-session): Bind command method.
+
+Wed Sep 17 03:28:36 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.6 is released.
+
+1997-08-17 SL Baur <steve@altair.xemacs.org>
+
+ * dgnushack.el (dgnushack-compile): Ignore .el files beginning
+ with an `=' character.
+
+Wed Sep 17 02:30:04 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-sum.el (gnus-build-sparse-threads): Allow display of looped
+ References.
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): Separated out into
+ function.
+
+ * message.el (message-delete-not-region): New command and
+ keystroke.
+
+Tue Sep 16 00:58:26 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * nndraft.el (nndraft-directory): Changed value.
+
+ * message.el (message-kill-buffer): Disassociate draft.
+ (message-mode): Use kill hook to disassociate.
+ (message-disassociate-draft): Double-check.
+
+ * gnus-agent.el (gnus-agentize): Don't set twice.
+
+ * gnus-art.el (gnus-article-prepare): Go to the right line before
+ marking.
+
+ * gnus-start.el: Renamed the drafts group.
+
+ * gnus-agent.el (gnus-agent-lib-file): Changed name of directory.
+
+ * gnus-draft.el (gnus-draft-mode): Simplify.
+
+Tue Sep 16 00:18:11 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.5 is released.
+
+Mon Sep 15 00:53:50 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-sum.el (gnus-alter-header-function): New variable.
+ (gnus-nov-parse-line): Use it.
+ (gnus-get-newsgroup-headers): Ditto.
+
+ * gnus-draft.el (gnus-group-send-drafts): Don't send when
+ unplugged.
+
+ * gnus-sum.el (gnus-summary-read-group): Don't show-all when
+ skipping groups.
+
+ * gnus-start.el (gnus-start-draft-setup): Changed name.
+
+Mon Sep 15 00:40:09 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.4 is released.
+
+Mon Sep 15 00:19:07 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-sum.el (gnus-summary-goto-article): Accept Message-ID's.
+
+Sun Sep 14 21:41:35 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-sum.el (gnus-group-make-articles-read): No params.
+
+ * nndraft.el (nndraft-status-string): Fix.
+
+ * gnus-draft.el (gnus-group-send-drafts): New command.
+
+ * gnus-sum.el (gnus-compute-read-articles): Separated.
+ (gnus-update-read-articles): Allow computation.
+
+ * nndraft.el (nndraft-articles): New function.
+
+ * message.el (message-send): Disabled test.
+
+Sun Sep 14 21:17:34 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.3 is released.
+
+Sun Sep 14 01:51:45 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-agent.el (gnus-agent-short-article): New variables.
+
+ * message.el (message-set-auto-save-file-name): Use drafts.
+
+ * nndraft.el (nndraft-request-expire-articles): Use it.
+
+ * nnmh.el (nnmh-deletable-article-p): Change.
+ (nnmh-allow-delete-final): New variable.
+
+ * gnus-msg.el (gnus-summary-send-draft): Removed.
+
+ * gnus.el (gnus-article-mark-lists): Save unsendable marks.
+
+ * gnus-sum.el (gnus-newsgroup-unsendable): New variable.
+
+ * gnus-draft.el: New file.
+
+ * gnus-sum.el (gnus-unsendable-mark): New variable.
+
+ * nndraft.el (nndraft-execute-nnmh-command): Cleanup.
+
+ * message.el (message-send-news): Use `gnus-request-post'.
+
+ * gnus-agent.el (gnus-agentize): New command.
+
+ * gnus-bcklg.el (gnus-backlog-remove-article): Remove the ident
+ from the list.
+
+Sun Sep 14 00:26:47 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.2 is released.
+
+Sun Sep 14 00:24:52 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-score.el (gnus-score-headers): Make sure the summary buffer
+ exists.
+
+Sat Sep 13 23:35:28 1997 Greg Stark <gsstark@mit.edu>
+
+ * gnus-ems.el (gnus-x-splash): New function.
+
+Sat Sep 13 22:46:16 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-start.el (gnus-1): Use it.
+
+ * gnus-ems.el (gnus-decode-coding-string): New alias.
+
+ * message.el (message-unix-mail-delimiter): Dox fox.
+
+ * nnmh.el (nnmh-request-list-1): Don't use coding system.
+
+ * gnus-sum.el (gnus-summary-catchup): Reverse logic.
+
+Sat Sep 13 21:21:38 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Quassia Gnus v0.1 is released.
--- /dev/null
+SHELL = /bin/sh
+EMACS=emacs
+FLAGS=-batch -q -no-site-file -l ./dgnushack.el
+
+total:
+ rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile
+
+all:
+ rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile
+
+clever:
+ $(EMACS) $(FLAGS) -f dgnushack-compile
+
+some:
+ $(EMACS) $(FLAGS) -f dgnushack-compile
+
+tags:
+ etags *.el
+
+separately:
+ rm -f *.elc ; for i in *.el; do $(EMACS) $(FLAGS) -f batch-byte-compile $$i; done
+
+pot:
+ xpot -drgnus -r`cat ./version` *.el > rgnus.pot
+
+gnus-load.el:
+ echo ";;; gnus-load.el --- automatically extracted custom dependencies" > gnus-load.el
+ echo ";;" >> gnus-load.el
+ echo ";;; Code:" >> gnus-load.el
+ echo >> gnus-load.el
+ $(EMACS) $(FLAGS) -l ./dgnushack.el -l cus-edit.el *.el \
+ -f custom-make-dependencies >> gnus-load.el
+ echo >> gnus-load.el
+ echo "(provide 'gnus-load)" >> gnus-load.el
+ echo >> gnus-load.el
+ echo ";;; gnus-load.el ends here" >> gnus-load.el
+
+distclean:
+ rm -f *.orig *.rej *.elc *~
+
--- /dev/null
+;;; dgnushack.el --- a hack to set the load path for byte-compiling
+;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Version: 4.19
+;; Keywords: news, path
+
+;; 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(fset 'facep 'ignore)
+
+(require 'cl)
+(require 'bytecomp)
+(push "." load-path)
+(push "~/lisp/custom" load-path)
+(require 'lpath)
+
+(defalias 'device-sound-enabled-p 'ignore)
+(defalias 'play-sound-file 'ignore)
+(defalias 'nndb-request-article 'ignore)
+(defalias 'efs-re-read-dir 'ignore)
+(defalias 'ange-ftp-re-read-dir 'ignore)
+(defalias 'define-mail-user-agent 'ignore)
+
+(eval-and-compile
+ (unless (string-match "XEmacs" emacs-version)
+ (fset 'get-popup-menu-response 'ignore)
+ (fset 'event-object 'ignore)
+ (fset 'x-defined-colors 'ignore)
+ (fset 'read-color 'ignore)))
+
+(setq byte-compile-warnings
+ '(free-vars unresolved callargs redefine))
+
+(defun dgnushack-compile ()
+ ;;(setq byte-compile-dynamic t)
+ (unless (locate-library "cus-edit")
+ (error "You do not seem to have Custom installed.
+Fetch it from <URL:http://www.dina.kvl.dk/~abraham/custom/>.
+You also then need to add the following to the lisp/dgnushack.el file:
+
+ (push \"~/lisp/custom\" load-path)
+
+Modify to suit your needs."))
+ (let ((files (directory-files "." nil "^[^=].*\\.el$"))
+ (xemacs (string-match "XEmacs" emacs-version))
+ ;;(byte-compile-generate-call-tree t)
+ file elc)
+ (condition-case ()
+ (require 'w3-forms)
+ (error (setq files (delete "nnweb.el" files))))
+ (while (setq file (pop files))
+ (when (or (and (not xemacs)
+ (not (member file '("gnus-xmas.el" "gnus-picon.el"
+ "messagexmas.el" "nnheaderxm.el"
+ "smiley.el" "x-overlay.el"))))
+ (and xemacs
+ (not (member file '("md5.el")))))
+ (when (or (not (file-exists-p (setq elc (concat file "c"))))
+ (file-newer-than-file-p file elc))
+ (ignore-errors
+ (byte-compile-file file)))))))
+
+(defun dgnushack-recompile ()
+ (require 'gnus)
+ (byte-recompile-directory "." 0))
+
+;;; dgnushack.el ends here
+
--- /dev/null
+;;; earcon.el --- Sound effects for messages
+;; Copyright (C) 1996 Free Software Foundation
+
+;; Author: Steven L. Baur <steve@miranova.com>
+;; Keywords: news fun sound
+
+;; 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;; This file provides access to sound effects in Gnus.
+
+;;; Code:
+
+(if (null (boundp 'running-xemacs))
+ (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)))
+
+(eval-when-compile (require 'cl))
+(require 'gnus)
+(require 'gnus-audio)
+(require 'gnus-art)
+
+(defgroup earcon nil
+ "Turn ** sounds ** into noise."
+ :group 'gnus-visual)
+
+(defcustom earcon-auto-play nil
+ "When True, automatically play sounds as well as buttonize them."
+ :type 'boolean
+ :group 'earcon)
+
+(defcustom earcon-prefix "**"
+ "String denoting the start of an earcon."
+ :type 'string
+ :group 'earcon)
+
+(defcustom earcon-suffix "**"
+ "String denoting the end of an earcon."
+ :type 'string
+ :group 'earcon)
+
+(defcustom earcon-regexp-alist
+ '(("boring" 1 "Boring.au")
+ ("evil[ \t]+laugh" 1 "Evil_Laugh.au")
+ ("gag\\|puke" 1 "Puke.au")
+ ("snicker" 1 "Snicker.au")
+ ("meow" 1 "catmeow.au")
+ ("sob\\|boohoo" 1 "cry.wav")
+ ("drum[ \t]*roll" 1 "drumroll.au")
+ ("blast" 1 "explosion.au")
+ ("flush\\|plonk!*" 1 "flush.au")
+ ("kiss" 1 "kiss.wav")
+ ("tee[ \t]*hee" 1 "laugh.au")
+ ("shoot" 1 "shotgun.wav")
+ ("yawn" 1 "snore.wav")
+ ("cackle" 1 "witch.au")
+ ("yell\\|roar" 1 "yell2.au")
+ ("whoop-de-doo" 1 "whistle.au"))
+ "A list of regexps to map earcons to real sounds."
+ :type '(repeat (list regexp
+ (integer :tag "Match")
+ (string :tag "Sound")))
+ :group 'earcon)
+
+(defvar earcon-button-marker-list nil)
+(make-variable-buffer-local 'earcon-button-marker-list)
+
+
+
+;;; FIXME!! clone of code from gnus-vis.el FIXME!!
+(defun earcon-article-push-button (event)
+ "Check text under the mouse pointer for a callback function.
+If the text under the mouse pointer has a `earcon-callback' property,
+call it with the value of the `earcon-data' text property."
+ (interactive "e")
+ (set-buffer (window-buffer (posn-window (event-start event))))
+ (let* ((pos (posn-point (event-start event)))
+ (data (get-text-property pos 'earcon-data))
+ (fun (get-text-property pos 'earcon-callback)))
+ (if fun (funcall fun data))))
+
+(defun earcon-article-press-button ()
+ "Check text at point for a callback function.
+If the text at point has a `earcon-callback' property,
+call it with the value of the `earcon-data' text property."
+ (interactive)
+ (let* ((data (get-text-property (point) 'earcon-data))
+ (fun (get-text-property (point) 'earcon-callback)))
+ (if fun (funcall fun data))))
+
+(defun earcon-article-prev-button (n)
+ "Move point to N buttons backward.
+If N is negative, move forward instead."
+ (interactive "p")
+ (earcon-article-next-button (- n)))
+
+(defun earcon-article-next-button (n)
+ "Move point to N buttons forward.
+If N is negative, move backward instead."
+ (interactive "p")
+ (let ((function (if (< n 0) 'previous-single-property-change
+ 'next-single-property-change))
+ (inhibit-point-motion-hooks t)
+ (backward (< n 0))
+ (limit (if (< n 0) (point-min) (point-max))))
+ (setq n (abs n))
+ (while (and (not (= limit (point)))
+ (> n 0))
+ ;; Skip past the current button.
+ (when (get-text-property (point) 'earcon-callback)
+ (goto-char (funcall function (point) 'earcon-callback nil limit)))
+ ;; Go to the next (or previous) button.
+ (gnus-goto-char (funcall function (point) 'earcon-callback nil limit))
+ ;; Put point at the start of the button.
+ (when (and backward (not (get-text-property (point) 'earcon-callback)))
+ (goto-char (funcall function (point) 'earcon-callback nil limit)))
+ ;; Skip past intangible buttons.
+ (when (get-text-property (point) 'intangible)
+ (incf n))
+ (decf n))
+ (unless (zerop n)
+ (gnus-message 5 "No more buttons"))
+ n))
+
+(defun earcon-article-add-button (from to fun &optional data)
+ "Create a button between FROM and TO with callback FUN and data DATA."
+ (and (boundp gnus-article-button-face)
+ gnus-article-button-face
+ (gnus-overlay-put (gnus-make-overlay from to)
+ 'face gnus-article-button-face))
+ (gnus-add-text-properties
+ from to
+ (nconc (and gnus-article-mouse-face
+ (list gnus-mouse-face-prop gnus-article-mouse-face))
+ (list 'gnus-callback fun)
+ (and data (list 'gnus-data data)))))
+
+(defun earcon-button-entry ()
+ ;; Return the first entry in `gnus-button-alist' matching this place.
+ (let ((alist earcon-regexp-alist)
+ (case-fold-search t)
+ (entry nil))
+ (while alist
+ (setq entry (pop alist))
+ (if (looking-at (car entry))
+ (setq alist nil)
+ (setq entry nil)))
+ entry))
+
+
+(defun earcon-button-push (marker)
+ ;; Push button starting at MARKER.
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char marker)
+ (let* ((entry (earcon-button-entry))
+ (inhibit-point-motion-hooks t)
+ (fun 'gnus-audio-play)
+ (args (list (nth 2 entry))))
+ (cond
+ ((fboundp fun)
+ (apply fun args))
+ ((and (boundp fun)
+ (fboundp (symbol-value fun)))
+ (apply (symbol-value fun) args))
+ (t
+ (gnus-message 1 "You must define `%S' to use this button"
+ (cons fun args)))))))
+
+;;; FIXME!! clone of code from gnus-vis.el FIXME!!
+
+;;;###interactive
+(defun earcon-region (beg end)
+ "Play Sounds in the region between point and mark."
+ (interactive "r")
+ (earcon-buffer (current-buffer) beg end))
+
+;;;###interactive
+(defun earcon-buffer (&optional buffer st nd)
+ (interactive)
+ (save-excursion
+ ;; clear old markers.
+ (if (boundp 'earcon-button-marker-list)
+ (while earcon-button-marker-list
+ (set-marker (pop earcon-button-marker-list) nil))
+ (setq earcon-button-marker-list nil))
+ (and buffer (set-buffer buffer))
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (case-fold-search t)
+ (alist earcon-regexp-alist)
+ beg entry regexp)
+ (goto-char (point-min))
+ (setq beg (point))
+ (while (setq entry (pop alist))
+ (setq regexp (concat (regexp-quote earcon-prefix)
+ ".*\\("
+ (car entry)
+ "\\).*"
+ (regexp-quote earcon-suffix)))
+ (goto-char beg)
+ (while (re-search-forward regexp nil t)
+ (let* ((start (and entry (match-beginning 1)))
+ (end (and entry (match-end 1)))
+ (from (match-beginning 1)))
+ (earcon-article-add-button
+ start end 'earcon-button-push
+ (car (push (set-marker (make-marker) from)
+ earcon-button-marker-list)))
+ (gnus-audio-play (caddr entry))))))))
+
+;;;###autoload
+(defun gnus-earcon-display ()
+ "Play sounds in message buffers."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char (point-min))
+ ;; Skip headers
+ (unless (search-forward "\n\n" nil t)
+ (goto-char (point-max)))
+ (sit-for 0)
+ (earcon-buffer (current-buffer) (point))))
+
+;;;***
+
+(provide 'earcon)
+
+(run-hooks 'earcon-load-hook)
+
+;;; earcon.el ends here
--- /dev/null
+;;; gnus-agent.el --- unplugged support for Gnus
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(require 'gnus-cache)
+(require 'nnvirtual)
+(require 'gnus-sum)
+(eval-when-compile (require 'cl))
+
+(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
+ "Where the Gnus agent will store its files."
+ :group 'gnus-agent
+ :type 'directory)
+
+(defcustom gnus-agent-plugged-hook nil
+ "Hook run when plugging into the network."
+ :group 'gnus-agent
+ :type 'hook)
+
+(defcustom gnus-agent-unplugged-hook nil
+ "Hook run when unplugging from the network."
+ :group 'gnus-agent
+ :type 'hook)
+
+;;; Internal variables
+
+(defvar gnus-agent-history-buffers nil)
+(defvar gnus-agent-buffer-alist nil)
+(defvar gnus-agent-article-alist nil)
+(defvar gnus-agent-group-alist nil)
+(defvar gnus-agent-covered-methods nil)
+(defvar gnus-category-alist nil)
+(defvar gnus-agent-current-history nil)
+(defvar gnus-agent-overview-buffer nil)
+(defvar gnus-category-predicate-cache nil)
+(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-plugged t
+ "Whether Gnus is plugged or not.")
+
+;; Dynamic variables
+(defvar gnus-headers)
+(defvar gnus-score)
+
+;;;
+;;; Setup
+;;;
+
+(defun gnus-open-agent ()
+ (setq gnus-agent t)
+ (gnus-agent-read-servers)
+ (gnus-category-read)
+ (setq gnus-agent-overview-buffer
+ (get-buffer-create " *Gnus agent overview*"))
+ (add-hook 'gnus-group-mode-hook 'gnus-agent-mode)
+ (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode)
+ (add-hook 'gnus-server-mode-hook 'gnus-agent-mode))
+
+(gnus-add-shutdown 'gnus-close-agent 'gnus)
+
+(defun gnus-close-agent ()
+ (setq gnus-agent-covered-methods nil
+ gnus-category-predicate-cache nil
+ gnus-category-group-cache nil
+ gnus-agent-spam-hashtb nil)
+ (gnus-kill-buffer gnus-agent-overview-buffer))
+
+;;;
+;;; Utility functions
+;;;
+
+(defun gnus-agent-read-file (file)
+ "Load FILE and do a `read' there."
+ (nnheader-temp-write nil
+ (ignore-errors
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (read (current-buffer)))))
+
+(defsubst gnus-agent-method ()
+ (concat (symbol-name (car gnus-command-method)) "/"
+ (if (equal (cadr gnus-command-method) "")
+ "unnamed"
+ (cadr gnus-command-method))))
+
+(defsubst gnus-agent-directory ()
+ "Path of the Gnus agent directory."
+ (nnheader-concat gnus-agent-directory (gnus-agent-method) "/"))
+
+(defun gnus-agent-lib-file (file)
+ "The full path of the Gnus agent library FILE."
+ (concat (gnus-agent-directory) "agent.lib/" file))
+
+;;;
+;;; Mode infestation
+;;;
+
+(defvar gnus-agent-mode-hook nil
+ "Hook run when installing agent mode.")
+
+(defvar gnus-agent-mode nil)
+(defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged"))
+
+(defun gnus-agent-mode ()
+ "Minor mode for providing a agent support in Gnus buffers."
+ (let* ((buffer (progn (string-match "^gnus-\\(.*\\)-mode$"
+ (symbol-name major-mode))
+ (match-string 1 (symbol-name major-mode))))
+ (mode (intern (format "gnus-agent-%s-mode" buffer))))
+ (set (make-local-variable 'gnus-agent-mode) t)
+ (set mode nil)
+ (set (make-local-variable mode) t)
+ ;; Set up the menu.
+ (when (gnus-visual-p 'agent-menu 'menu)
+ (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer))))
+ (unless (assq 'gnus-agent-mode minor-mode-alist)
+ (push gnus-agent-mode-status minor-mode-alist))
+ (unless (assq mode minor-mode-map-alist)
+ (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
+ buffer))))
+ minor-mode-map-alist))
+ (gnus-agent-toggle-plugged gnus-plugged)
+ (run-hooks 'gnus-agent-mode-hook)))
+
+(defvar gnus-agent-group-mode-map (make-sparse-keymap))
+(gnus-define-keys gnus-agent-group-mode-map
+ "Ju" gnus-agent-fetch-group
+ "Jc" gnus-enter-category-buffer
+ "Jj" gnus-agent-toggle-plugged
+ "Js" gnus-agent-fetch-session
+ "JS" gnus-group-send-drafts
+ "Ja" gnus-agent-add-group)
+
+(defun gnus-agent-group-make-menu-bar ()
+ (unless (boundp 'gnus-agent-group-menu)
+ (easy-menu-define
+ gnus-agent-group-menu gnus-agent-group-mode-map ""
+ '("Agent"
+ ["Toggle plugged" gnus-agent-toggle-plugged t]
+ ["List categories" gnus-enter-category-buffer t]
+ ["Send drafts" gnus-group-send-drafts gnus-plugged]
+ ("Fetch"
+ ["All" gnus-agent-fetch-session gnus-plugged]
+ ["Group" gnus-agent-fetch-group gnus-plugged])))))
+
+(defvar gnus-agent-summary-mode-map (make-sparse-keymap))
+(gnus-define-keys gnus-agent-summary-mode-map
+ "Jj" gnus-agent-toggle-plugged
+ "J#" gnus-agent-mark-article
+ "J\M-#" gnus-agent-unmark-article
+ "@" gnus-agent-toggle-mark
+ "Jc" gnus-agent-catchup)
+
+(defun gnus-agent-summary-make-menu-bar ()
+ (unless (boundp 'gnus-agent-summary-menu)
+ (easy-menu-define
+ gnus-agent-summary-menu gnus-agent-summary-mode-map ""
+ '("Agent"
+ ["Toggle plugged" gnus-agent-toggle-plugged t]
+ ["Mark as downloadable" gnus-agent-mark-article t]
+ ["Unmark as downloadable" gnus-agent-unmark-article t]
+ ["Toggle mark" gnus-agent-toggle-mark t]
+ ["Catchup undownloaded" gnus-agent-catchup t]))))
+
+(defvar gnus-agent-server-mode-map (make-sparse-keymap))
+(gnus-define-keys gnus-agent-server-mode-map
+ "Jj" gnus-agent-toggle-plugged
+ "Ja" gnus-agent-add-server
+ "Jr" gnus-agent-remove-server)
+
+(defun gnus-agent-server-make-menu-bar ()
+ (unless (boundp 'gnus-agent-server-menu)
+ (easy-menu-define
+ gnus-agent-server-menu gnus-agent-server-mode-map ""
+ '("Agent"
+ ["Toggle plugged" gnus-agent-toggle-plugged t]
+ ["Add" gnus-agent-add-server t]
+ ["Remove" gnus-agent-remove-server t]))))
+
+(defun gnus-agent-toggle-plugged (plugged)
+ "Toggle whether Gnus is unplugged or not."
+ (interactive (list (not gnus-plugged)))
+ (if plugged
+ (progn
+ (run-hooks 'gnus-agent-plugged-hook)
+ (setcar (cdr gnus-agent-mode-status) " Plugged"))
+ (gnus-agent-close-connections)
+ (run-hooks 'gnus-agent-unplugged-hook)
+ (setcar (cdr gnus-agent-mode-status) " Unplugged"))
+ (setq gnus-plugged plugged)
+ (set-buffer-modified-p t))
+
+(defun gnus-agent-close-connections ()
+ "Close all methods covered by the Gnus agent."
+ (let ((methods gnus-agent-covered-methods))
+ (while methods
+ (gnus-close-server (pop methods)))))
+
+;;;###autoload
+(defun gnus-unplugged ()
+ "Start Gnus unplugged."
+ (interactive)
+ (setq gnus-plugged nil)
+ (gnus))
+
+;;;###autoload
+(defun gnus-agentize ()
+ "Allow Gnus to be an offline newsreader.
+The normal usage of this command is to put the following as the
+last form in your `.gnus.el' file:
+
+\(gnus-agentize)
+
+This will modify the `gnus-before-startup-hook', `gnus-post-method',
+and `message-send-mail-function' variables, and install the Gnus
+agent minor mode in all Gnus buffers."
+ (interactive)
+ (gnus-open-agent)
+ (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup)
+ (unless gnus-agent-send-mail-function
+ (setq gnus-agent-send-mail-function message-send-mail-function
+ message-send-mail-function 'gnus-agent-send-mail))
+ (unless gnus-agent-covered-methods
+ (setq gnus-agent-covered-methods (list gnus-select-method))))
+
+(defun gnus-agent-queue-setup ()
+ "Make sure the queue group exists."
+ (unless (gnus-gethash "nndraft:queue" gnus-newsrc-hashtb)
+ (gnus-request-create-group "queue" '(nndraft ""))
+ (let ((gnus-level-default-subscribed 1))
+ (gnus-subscribe-group "nndraft:queue" nil '(nndraft "")))
+ (gnus-group-set-parameter
+ "nndraft:queue" 'gnus-dummy '((gnus-draft-mode)))))
+
+(defun gnus-agent-send-mail ()
+ (if gnus-plugged
+ (funcall gnus-agent-send-mail-function)
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (gnus-request-accept-article "nndraft:queue")))
+
+;;;
+;;; Group mode commands
+;;;
+
+(defun gnus-agent-fetch-group (group)
+ "Put all new articles in GROUP into the agent."
+ (interactive (list (gnus-group-group-name)))
+ (unless group
+ (error "No group on the current line"))
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (gnus-agent-with-fetch
+ (gnus-agent-fetch-group-1 group gnus-command-method))))
+
+(defun gnus-agent-add-group (category arg)
+ "Add the current group to an agent category."
+ (interactive
+ (list
+ (intern
+ (completing-read
+ "Add to category: "
+ (mapcar (lambda (cat) (list (symbol-name (car cat))))
+ gnus-category-alist)
+ nil t))
+ current-prefix-arg))
+ (let ((cat (assq category gnus-category-alist))
+ c groups)
+ (gnus-group-iterate arg
+ (lambda (group)
+ (when (cadddr (setq c (gnus-group-category group)))
+ (setf (cadddr c) (delete group (cadddr c))))
+ (push group groups)))
+ (setf (cadddr cat) (nconc (cadddr cat) groups))
+ (gnus-category-write)))
+
+;;;
+;;; Server mode commands
+;;;
+
+(defun gnus-agent-add-server (server)
+ "Enroll SERVER in the agent program."
+ (interactive (list (gnus-server-server-name)))
+ (unless server
+ (error "No server on the current line"))
+ (let ((method (gnus-server-get-method nil (gnus-server-server-name))))
+ (when (member method gnus-agent-covered-methods)
+ (error "Server already in the agent program"))
+ (push method gnus-agent-covered-methods)
+ (gnus-agent-write-servers)
+ (message "Entered %s into the agent" server)))
+
+(defun gnus-agent-remove-server (server)
+ "Remove SERVER from the agent program."
+ (interactive (list (gnus-server-server-name)))
+ (unless server
+ (error "No server on the current line"))
+ (let ((method (gnus-server-get-method nil (gnus-server-server-name))))
+ (unless (member method gnus-agent-covered-methods)
+ (error "Server not in the agent program"))
+ (setq gnus-agent-covered-methods
+ (delete method gnus-agent-covered-methods))
+ (gnus-agent-write-servers)
+ (message "Removed %s from the agent" server)))
+
+(defun gnus-agent-read-servers ()
+ "Read the alist of covered servers."
+ (setq gnus-agent-covered-methods
+ (gnus-agent-read-file
+ (nnheader-concat gnus-agent-directory "lib/servers"))))
+
+(defun gnus-agent-write-servers ()
+ "Write the alist of covered servers."
+ (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/servers")
+ (prin1 gnus-agent-covered-methods (current-buffer))))
+
+;;;
+;;; Summary commands
+;;;
+
+(defun gnus-agent-mark-article (n &optional unmark)
+ "Mark the next N articles as downloadable.
+If N is negative, mark backward instead. If UNMARK is non-nil, remove
+the mark instead. The difference between N and the actual number of
+articles marked is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (while (and
+ (> n 0)
+ (progn
+ (gnus-summary-set-agent-mark
+ (gnus-summary-article-number) unmark)
+ (zerop (gnus-summary-next-subject (if backward -1 1) nil t))))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more articles"))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ n))
+
+(defun gnus-agent-unmark-article (n)
+ "Remove the downloadable mark from the next N articles.
+If N is negative, unmark backward instead. The difference between N and
+the actual number of articles unmarked is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-agent-mark-article n t))
+
+(defun gnus-agent-toggle-mark (n)
+ "Toggle the downloadable mark from the next N articles.
+If N is negative, toggle backward instead. The difference between N and
+the actual number of articles toggled is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-agent-mark-article n 'toggle))
+
+(defun gnus-summary-set-agent-mark (article &optional unmark)
+ "Mark ARTICLE as downloadable."
+ (let ((unmark (if (and (not (null unmark)) (not (eq t unmark)))
+ (memq article gnus-newsgroup-downloadable)
+ unmark)))
+ (setq gnus-newsgroup-downloadable
+ (delq article gnus-newsgroup-downloadable))
+ (unless unmark
+ (push article gnus-newsgroup-downloadable))
+ (gnus-summary-update-mark
+ (if unmark gnus-undownloaded-mark gnus-downloadable-mark)
+ 'unread)))
+
+(defun gnus-agent-get-undownloaded-list ()
+ "Mark all unfetched articles as read."
+ (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
+ (when (and (not gnus-plugged)
+ (gnus-agent-method-p gnus-command-method))
+ (gnus-agent-load-alist gnus-newsgroup-name)
+ (let ((articles gnus-newsgroup-unreads)
+ article)
+ (while (setq article (pop articles))
+ (unless (or (cdr (assq article gnus-agent-article-alist))
+ (memq article gnus-newsgroup-downloadable))
+ (push article gnus-newsgroup-undownloaded)))))))
+
+(defun gnus-agent-catchup ()
+ "Mark all undownloaded articles as read."
+ (interactive)
+ (save-excursion
+ (while gnus-newsgroup-undownloaded
+ (gnus-summary-mark-article
+ (pop gnus-newsgroup-undownloaded) gnus-catchup-mark)))
+ (gnus-summary-position-point))
+
+;;;
+;;; Internal functions
+;;;
+
+(defun gnus-agent-save-active (method)
+ (when (gnus-agent-method-p method)
+ (let* ((gnus-command-method method)
+ (file (gnus-agent-lib-file "active")))
+ (gnus-make-directory (file-name-directory file))
+ (write-region (point-min) (point-max) file nil 'silent)
+ (when (file-exists-p (gnus-agent-lib-file "groups"))
+ (delete-file (gnus-agent-lib-file "groups"))))))
+
+(defun gnus-agent-save-groups (method)
+ (let* ((gnus-command-method method)
+ (file (gnus-agent-lib-file "groups")))
+ (gnus-make-directory (file-name-directory file))
+ (write-region (point-min) (point-max) file nil 'silent))
+ (when (file-exists-p (gnus-agent-lib-file "active"))
+ (delete-file (gnus-agent-lib-file "active"))))
+
+(defun gnus-agent-group-path (group)
+ "Translate GROUP into a path."
+ (nnheader-replace-chars-in-string group ?. ?/))
+
+\f
+
+(defun gnus-agent-method-p (method)
+ "Say whether METHOD is covered by the agent."
+ (member method gnus-agent-covered-methods))
+
+(defun gnus-agent-get-function (method)
+ (if (and (not gnus-plugged)
+ (gnus-agent-method-p method))
+ (progn
+ (require 'nnagent)
+ 'nnagent)
+ (car method)))
+
+;;; History functions
+
+(defun gnus-agent-history-buffer ()
+ (cdr (assoc (gnus-agent-method) gnus-agent-history-buffers)))
+
+(defun gnus-agent-open-history ()
+ (save-excursion
+ (push (cons (gnus-agent-method)
+ (set-buffer (get-buffer-create
+ (format " *Gnus agent %s history*"
+ (gnus-agent-method)))))
+ gnus-agent-history-buffers)
+ (erase-buffer)
+ (insert "\n")
+ (let ((file (gnus-agent-lib-file "history")))
+ (when (file-exists-p file)
+ (insert-file file))
+ (set (make-local-variable 'gnus-agent-file-name) file))))
+
+(defun gnus-agent-save-history ()
+ (save-excursion
+ (set-buffer gnus-agent-current-history)
+ (gnus-make-directory (file-name-directory gnus-agent-file-name))
+ (write-region (1+ (point-min)) (point-max)
+ gnus-agent-file-name nil 'silent)))
+
+(defun gnus-agent-close-history ()
+ (when (gnus-buffer-live-p gnus-agent-current-history)
+ (kill-buffer gnus-agent-current-history)
+ (setq gnus-agent-history-buffers
+ (delq (assoc (gnus-agent-method) gnus-agent-history-buffers)
+ gnus-agent-history-buffers))))
+
+(defun gnus-agent-enter-history (id group-arts date)
+ (save-excursion
+ (set-buffer gnus-agent-current-history)
+ (goto-char (point-max))
+ (insert id "\t" (number-to-string date) "\t")
+ (while group-arts
+ (insert (caar group-arts) "/" (number-to-string (cdr (pop group-arts)))
+ " "))
+ (insert "\n")))
+
+(defun gnus-agent-article-in-history-p (id)
+ (save-excursion
+ (set-buffer (gnus-agent-history-buffer))
+ (goto-char (point-min))
+ (search-forward (concat "\n" id "\t") nil t)))
+
+(defun gnus-agent-history-path (id)
+ (save-excursion
+ (set-buffer (gnus-agent-history-buffer))
+ (goto-char (point-min))
+ (when (search-forward (concat "\n" id "\t") nil t)
+ (let ((method (gnus-agent-method)))
+ (let (paths group)
+ (while (not (numberp (setq group (read (current-buffer)))))
+ (push (concat method "/" group) paths))
+ (nreverse paths))))))
+
+;;;
+;;; Fetching
+;;;
+
+(defun gnus-agent-start-fetch ()
+ "Initialize data structures for efficient fetching."
+ (gnus-agent-open-history)
+ (setq gnus-agent-current-history (gnus-agent-history-buffer)))
+
+(defun gnus-agent-stop-fetch ()
+ "Save all data structures and clean up."
+ (gnus-agent-save-history)
+ (gnus-agent-close-history)
+ (setq gnus-agent-spam-hashtb nil)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (widen)))
+
+(defmacro gnus-agent-with-fetch (&rest forms)
+ "Do FORMS safely."
+ `(unwind-protect
+ (progn
+ (gnus-agent-start-fetch)
+ ,@forms)
+ (gnus-agent-stop-fetch)))
+
+(put 'gnus-agent-with-fetch 'lisp-indent-function 0)
+(put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
+
+(defun gnus-agent-fetch-articles (group articles)
+ "Fetch ARTICLES from GROUP and put them into the agent."
+ (when articles
+ ;; Prune off articles that we have already fetched.
+ (while (and articles
+ (cdr (assq (car articles) gnus-agent-article-alist)))
+ (pop articles))
+ (let ((arts articles))
+ (while (cdr arts)
+ (if (cdr (assq (cadr arts) gnus-agent-article-alist))
+ (setcdr arts (cddr arts))
+ (setq arts (cdr arts)))))
+ (when articles
+ (let ((dir (concat
+ (gnus-agent-directory)
+ (gnus-agent-group-path group) "/"))
+ (date (gnus-time-to-day (current-time)))
+ (case-fold-search t)
+ pos alists crosses id elem)
+ (gnus-make-directory dir)
+ (gnus-message 7 "Fetching articles for %s..." group)
+ ;; Fetch the articles from the backend.
+ (if (gnus-check-backend-function 'retrieve-articles group)
+ (setq pos (gnus-retrieve-articles articles group))
+ (nnheader-temp-write nil
+ (let ((buf (current-buffer))
+ article)
+ (while (setq article (pop articles))
+ (when (gnus-request-article article group)
+ (goto-char (point-max))
+ (push (cons article (point)) pos)
+ (insert-buffer-substring nntp-server-buffer)))
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ (setq pos (nreverse pos)))))
+ ;; Then save these articles into the agent.
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (while pos
+ (narrow-to-region (cdar pos) (or (cdadr pos) (point-max)))
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (when (search-backward "\nXrefs: " nil t)
+ ;; Handle crossposting.
+ (skip-chars-forward "^ ")
+ (skip-chars-forward " ")
+ (setq crosses nil)
+ (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) +")
+ (push (cons (buffer-substring (match-beginning 1)
+ (match-end 1))
+ (buffer-substring (match-beginning 2)
+ (match-end 2)))
+ crosses)
+ (goto-char (match-end 0)))
+ (gnus-agent-crosspost crosses (caar pos))))
+ (goto-char (point-min))
+ (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t))
+ (setq id "No-Message-ID-in-article")
+ (setq id (buffer-substring (match-beginning 1) (match-end 1))))
+ (write-region (point-min) (point-max)
+ (concat dir (number-to-string (caar pos)))
+ nil 'silent)
+ (when (setq elem (assq (caar pos) gnus-agent-article-alist))
+ (setcdr elem t))
+ (gnus-agent-enter-history
+ id (or crosses (list (cons group (caar pos)))) date)
+ (widen)
+ (pop pos)))
+ (gnus-agent-save-alist group)))))
+
+(defun gnus-agent-crosspost (crosses article)
+ (let (gnus-agent-article-alist group alist beg end)
+ (save-excursion
+ (set-buffer gnus-agent-overview-buffer)
+ (when (nnheader-find-nov-line article)
+ (forward-word 1)
+ (setq beg (point))
+ (setq end (progn (forward-line 1) (point)))))
+ (while crosses
+ (setq group (caar crosses))
+ (unless (setq alist (assoc group gnus-agent-group-alist))
+ (push (setq alist (list group (gnus-agent-load-alist (caar crosses))))
+ gnus-agent-group-alist))
+ (setcdr alist (cons (cons (cdar crosses) t) (cdr alist)))
+ (save-excursion
+ (set-buffer (get-buffer-create (format " *Gnus agent overview %s*"
+ group)))
+ (when (= (point-max) (point-min))
+ (push (cons group (current-buffer)) gnus-agent-buffer-alist)
+ (ignore-errors
+ (insert-file-contents
+ (gnus-agent-article-name ".overview" group))))
+ (nnheader-find-nov-line (string-to-number (cdar crosses)))
+ (insert (string-to-number (cdar crosses)))
+ (insert-buffer-substring gnus-agent-overview-buffer beg end))
+ (pop crosses))))
+
+(defun gnus-agent-flush-cache ()
+ (save-excursion
+ (while gnus-agent-buffer-alist
+ (set-buffer (cdar gnus-agent-buffer-alist))
+ (write-region (point-min) (point-max)
+ (gnus-agent-article-name ".overview"
+ (caar gnus-agent-buffer-alist))
+ nil 'silent)
+ (pop gnus-agent-buffer-alist))
+ (while gnus-agent-group-alist
+ (nnheader-temp-write (caar gnus-agent-group-alist)
+ (princ (cdar gnus-agent-group-alist))
+ (insert "\n"))
+ (pop gnus-agent-group-alist))))
+
+(defun gnus-agent-fetch-headers (group articles &optional force)
+ (gnus-agent-load-alist group)
+ ;; Find out what headers we need to retrieve.
+ (when articles
+ (while (and articles
+ (assq (car articles) gnus-agent-article-alist))
+ (pop articles))
+ (let ((arts articles))
+ (while (cdr arts)
+ (if (assq (cadr arts) gnus-agent-article-alist)
+ (setcdr arts (cddr arts))
+ (setq arts (cdr arts)))))
+ ;; Fetch them.
+ (when articles
+ (gnus-message 7 "Fetching headers for %s..." group)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (unless (eq 'nov (gnus-retrieve-headers articles group))
+ (nnvirtual-convert-headers))
+ ;; Save these headers for later processing.
+ (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
+ (let (file)
+ (when (file-exists-p
+ (setq file (gnus-agent-article-name ".overview" group)))
+ (gnus-agent-braid-nov group articles file))
+ (gnus-make-directory (file-name-directory file))
+ (write-region (point-min) (point-max) file nil 'silent)
+ (gnus-agent-save-alist group articles nil))
+ t))))
+
+(defsubst gnus-agent-copy-nov-line (article)
+ (let (b e)
+ (set-buffer gnus-agent-overview-buffer)
+ (setq b (point))
+ (if (eq article (read (current-buffer)))
+ (setq e (progn (forward-line 1) (point)))
+ (setq e b))
+ (set-buffer nntp-server-buffer)
+ (insert-buffer-substring gnus-agent-overview-buffer b e)))
+
+(defun gnus-agent-braid-nov (group articles file)
+ (let (beg end)
+ (set-buffer gnus-agent-overview-buffer)
+ (goto-char (point-min))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (if (or (= (point-min) (point-max))
+ (progn
+ (forward-line -1)
+ (< (read (current-buffer)) (car articles))))
+ ;; We have only headers that are after the older headers,
+ ;; so we just append them.
+ (progn
+ (goto-char (point-max))
+ (insert-buffer-substring gnus-agent-overview-buffer))
+ ;; We do it the hard way.
+ (nnheader-find-nov-line (car articles))
+ (gnus-agent-copy-nov-line (car articles))
+ (pop articles)
+ (while (and articles
+ (not (eobp)))
+ (while (and (not (eobp))
+ (< (read (current-buffer)) (car articles)))
+ (forward-line 1))
+ (beginning-of-line)
+ (unless (eobp)
+ (gnus-agent-copy-nov-line (car articles))
+ (setq articles (cdr articles))))
+ (when articles
+ (let (b e)
+ (set-buffer gnus-agent-overview-buffer)
+ (setq b (point)
+ e (point-max))
+ (set-buffer nntp-server-buffer)
+ (insert-buffer-substring gnus-agent-overview-buffer b e))))))
+
+(defun gnus-agent-load-alist (group &optional dir)
+ "Load the article-state alist for GROUP."
+ (setq gnus-agent-article-alist
+ (gnus-agent-read-file
+ (if dir
+ (concat dir ".agentview")
+ (gnus-agent-article-name ".agentview" group)))))
+
+(defun gnus-agent-save-alist (group &optional articles state dir)
+ "Load the article-state alist for GROUP."
+ (nnheader-temp-write (if dir
+ (concat dir ".agentview")
+ (gnus-agent-article-name ".agentview" group))
+ (princ (setq gnus-agent-article-alist
+ (nconc gnus-agent-article-alist
+ (mapcar (lambda (article) (cons article state))
+ articles)))
+ (current-buffer))
+ (insert "\n")))
+
+(defun gnus-agent-article-name (article group)
+ (concat (gnus-agent-directory) (gnus-agent-group-path group) "/"
+ (if (stringp article) article (string-to-number article))))
+
+(defun gnus-agent-fetch-session ()
+ "Fetch all articles and headers that are eligible for fetching."
+ (interactive)
+ (unless gnus-agent-covered-methods
+ (error "No servers are covered by the Gnus agent"))
+ (unless gnus-plugged
+ (error "Can't fetch articles while Gnus is unplugged"))
+ (let ((methods gnus-agent-covered-methods)
+ groups group gnus-command-method)
+ (save-excursion
+ (while methods
+ (setq gnus-command-method (car methods)
+ groups (gnus-groups-from-server (pop methods)))
+ (gnus-agent-with-fetch
+ (while (setq group (pop groups))
+ (gnus-agent-fetch-group-1 group gnus-command-method))))
+ (gnus-message 6 "Finished fetching articles into the Gnus agent"))))
+
+(defun gnus-agent-fetch-group-1 (group method)
+ "Fetch GROUP."
+ (let ((gnus-command-method method)
+ gnus-newsgroup-dependencies gnus-newsgroup-headers
+ gnus-newsgroup-scored gnus-headers gnus-score
+ gnus-use-cache articles score arts
+ category predicate info marks score-param)
+ ;; Fetch headers.
+ (when (and (setq articles (gnus-list-of-unread-articles group))
+ (gnus-agent-fetch-headers group articles))
+ ;; Parse them and see which articles we want to fetch.
+ (setq gnus-newsgroup-dependencies
+ (make-vector (length articles) 0))
+ (setq gnus-newsgroup-headers
+ (gnus-get-newsgroup-headers-xover articles nil nil group))
+ (setq category (gnus-group-category group))
+ (setq predicate
+ (gnus-get-predicate
+ (or (gnus-group-get-parameter group 'agent-predicate)
+ (cadr category))))
+ (setq score-param
+ (or (gnus-group-get-parameter group 'agent-score)
+ (caddr category)))
+ (when score-param
+ (gnus-score-headers (list (list score-param))))
+ (setq arts nil)
+ (while (setq gnus-headers (pop gnus-newsgroup-headers))
+ (setq gnus-score
+ (or (cdr (assq (mail-header-number gnus-headers)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score))
+ (when (funcall predicate)
+ (push (mail-header-number gnus-headers)
+ arts)))
+ ;; Fetch the articles.
+ (when arts
+ (gnus-agent-fetch-articles group arts)))
+ ;; Perhaps we have some additional articles to fetch.
+ (setq arts (assq 'download (gnus-info-marks
+ (setq info (gnus-get-info group)))))
+ (when (cdr arts)
+ (gnus-agent-fetch-articles
+ group (gnus-uncompress-range (cdr arts)))
+ (setq marks (delq arts (gnus-info-marks info)))
+ (gnus-info-set-marks info marks))))
+
+;;;
+;;; Agent Category Mode
+;;;
+
+(defvar gnus-category-mode-hook nil
+ "Hook run in `gnus-category-mode' buffers.")
+
+(defvar gnus-category-line-format " %(%20c%): %g\n"
+ "Format of category lines.")
+
+(defvar gnus-category-mode-line-format "Gnus: %%b"
+ "The format specification for the category mode line.")
+
+(defvar gnus-agent-short-article 100
+ "Articles that have fewer lines than this are short.")
+
+(defvar gnus-agent-long-article 200
+ "Articles that have more lines than this are long.")
+
+(defvar gnus-agent-low-score 0
+ "Articles that have a score lower than this have a low score.")
+
+(defvar gnus-agent-high-score 0
+ "Articles that have a score higher than this have a high score.")
+
+
+;;; Internal variables.
+
+(defvar gnus-category-buffer "*Agent Category*")
+
+(defvar gnus-category-line-format-alist
+ `((?c name ?s)
+ (?g groups ?d)))
+
+(defvar gnus-category-mode-line-format-alist
+ `((?u user-defined ?s)))
+
+(defvar gnus-category-line-format-spec nil)
+(defvar gnus-category-mode-line-format-spec nil)
+
+(defvar gnus-category-mode-map nil)
+(put 'gnus-category-mode 'mode-class 'special)
+
+(unless gnus-category-mode-map
+ (setq gnus-category-mode-map (make-sparse-keymap))
+ (suppress-keymap gnus-category-mode-map)
+
+ (gnus-define-keys gnus-category-mode-map
+ "q" gnus-category-exit
+ "k" gnus-category-kill
+ "c" gnus-category-copy
+ "a" gnus-category-add
+ "p" gnus-category-edit-predicate
+ "g" gnus-category-edit-groups
+ "s" gnus-category-edit-score
+ "l" gnus-category-list
+
+ "\C-c\C-i" gnus-info-find-node
+ "\C-c\C-b" gnus-bug))
+
+(defvar gnus-category-menu-hook nil
+ "*Hook run after the creation of the menu.")
+
+(defun gnus-category-make-menu-bar ()
+ (gnus-turn-off-edit-menu 'category)
+ (unless (boundp 'gnus-category-menu)
+ (easy-menu-define
+ gnus-category-menu gnus-category-mode-map ""
+ '("Categories"
+ ["Add" gnus-category-add t]
+ ["Kill" gnus-category-kill t]
+ ["Copy" gnus-category-copy t]
+ ["Edit predicate" gnus-category-edit-predicate t]
+ ["Edit score" gnus-category-edit-score t]
+ ["Edit groups" gnus-category-edit-groups t]
+ ["Exit" gnus-category-exit t]))
+
+ (run-hooks 'gnus-category-menu-hook)))
+
+(defun gnus-category-mode ()
+ "Major mode for listing and editing agent categories.
+
+All normal editing commands are switched off.
+\\<gnus-category-mode-map>
+For more in-depth information on this mode, read the manual
+(`\\[gnus-info-find-node]').
+
+The following commands are available:
+
+\\{gnus-category-mode-map}"
+ (interactive)
+ (when (gnus-visual-p 'category-menu 'menu)
+ (gnus-category-make-menu-bar))
+ (kill-all-local-variables)
+ (gnus-simplify-mode-line)
+ (setq major-mode 'gnus-category-mode)
+ (setq mode-name "Category")
+ (gnus-set-default-directory)
+ (setq mode-line-process nil)
+ (use-local-map gnus-category-mode-map)
+ (buffer-disable-undo (current-buffer))
+ (setq truncate-lines t)
+ (setq buffer-read-only t)
+ (run-hooks 'gnus-category-mode-hook))
+
+(defalias 'gnus-category-position-point 'gnus-goto-colon)
+
+(defun gnus-category-insert-line (category)
+ (let* ((name (car category))
+ (groups (length (cadddr category))))
+ (beginning-of-line)
+ (gnus-add-text-properties
+ (point)
+ (prog1 (1+ (point))
+ ;; Insert the text.
+ (eval gnus-category-line-format-spec))
+ (list 'gnus-category name))))
+
+(defun gnus-enter-category-buffer ()
+ "Go to the Category buffer."
+ (interactive)
+ (gnus-category-setup-buffer)
+ (gnus-configure-windows 'category)
+ (gnus-category-prepare))
+
+(defun gnus-category-setup-buffer ()
+ (unless (get-buffer gnus-category-buffer)
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-category-buffer))
+ (gnus-add-current-to-buffer-list)
+ (gnus-category-mode))))
+
+(defun gnus-category-prepare ()
+ (gnus-set-format 'category-mode)
+ (gnus-set-format 'category t)
+ (let ((alist gnus-category-alist)
+ (buffer-read-only nil))
+ (erase-buffer)
+ (while alist
+ (gnus-category-insert-line (pop alist)))
+ (goto-char (point-min))
+ (gnus-category-position-point)))
+
+(defun gnus-category-name ()
+ (or (get-text-property (gnus-point-at-bol) 'gnus-category)
+ (error "No category on the current line")))
+
+(defun gnus-category-read ()
+ "Read the category alist."
+ (setq gnus-category-alist
+ (or (gnus-agent-read-file
+ (nnheader-concat gnus-agent-directory "lib/categories"))
+ (list (list 'default 'true nil nil)))))
+
+(defun gnus-category-write ()
+ "Write the category alist."
+ (setq gnus-category-predicate-cache nil
+ gnus-category-group-cache nil)
+ (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/categories")
+ (prin1 gnus-category-alist (current-buffer))))
+
+(defun gnus-category-edit-predicate (category)
+ "Edit the predicate for CATEGORY."
+ (interactive (list (gnus-category-name)))
+ (let ((info (assq category gnus-category-alist)))
+ (gnus-edit-form
+ (cadr info) (format "Editing the predicate for category %s" category)
+ `(lambda (predicate)
+ (setf (cadr (assq ',category gnus-category-alist)) predicate)
+ (gnus-category-write)
+ (gnus-category-list)))))
+
+(defun gnus-category-edit-score (category)
+ "Edit the score expression for CATEGORY."
+ (interactive (list (gnus-category-name)))
+ (let ((info (assq category gnus-category-alist)))
+ (gnus-edit-form
+ (caddr info)
+ (format "Editing the score expression for category %s" category)
+ `(lambda (groups)
+ (setf (caddr (assq ',category gnus-category-alist)) groups)
+ (gnus-category-write)
+ (gnus-category-list)))))
+
+(defun gnus-category-edit-groups (category)
+ "Edit the group list for CATEGORY."
+ (interactive (list (gnus-category-name)))
+ (let ((info (assq category gnus-category-alist)))
+ (gnus-edit-form
+ (cadddr info) (format "Editing the group list for category %s" category)
+ `(lambda (groups)
+ (setf (cadddr (assq ',category gnus-category-alist)) groups)
+ (gnus-category-write)
+ (gnus-category-list)))))
+
+(defun gnus-category-kill (category)
+ "Kill the current category."
+ (interactive (list (gnus-category-name)))
+ (let ((info (assq category gnus-category-alist))
+ (buffer-read-only nil))
+ (gnus-delete-line)
+ (gnus-category-write)
+ (setq gnus-category-alist (delq info gnus-category-alist))))
+
+(defun gnus-category-copy (category to)
+ "Copy the current category."
+ (interactive (list (gnus-category-name) (intern (read-string "New name: "))))
+ (let ((info (assq category gnus-category-alist)))
+ (push (list to (gnus-copy-sequence (cadr info))
+ (gnus-copy-sequence (caddr info)) nil)
+ gnus-category-alist)
+ (gnus-category-write)
+ (gnus-category-list)))
+
+(defun gnus-category-add (category)
+ "Create a new category."
+ (interactive "SCategory name: ")
+ (when (assq category gnus-category-alist)
+ (error "Category %s already exists" category))
+ (push (list category 'true nil nil)
+ gnus-category-alist)
+ (gnus-category-write)
+ (gnus-category-list))
+
+(defun gnus-category-list ()
+ "List all categories."
+ (interactive)
+ (gnus-category-prepare))
+
+(defun gnus-category-exit ()
+ "Return to the group buffer."
+ (interactive)
+ (kill-buffer (current-buffer))
+ (gnus-configure-windows 'group t))
+
+;; To avoid having 8-bit characters in the source file.
+(defvar gnus-category-not (list '! 'not (intern (format "%c" 172))))
+
+(defvar gnus-category-predicate-alist
+ '((spam . gnus-agent-spam-p)
+ (short . gnus-agent-short-p)
+ (long . gnus-agent-long-p)
+ (low . gnus-agent-low-scored-p)
+ (high . gnus-agent-high-scored-p)
+ (true . gnus-agent-true)
+ (false . gnus-agent-false))
+ "Mapping from short score predicate symbols to predicate functions.")
+
+(defun gnus-agent-spam-p ()
+ "Say whether an article is spam or not."
+ (unless gnus-agent-spam-hashtb
+ (setq gnus-agent-spam-hashtb (gnus-make-hashtable 1000)))
+ (if (not (equal (mail-header-references gnus-headers) ""))
+ nil
+ (let ((string (gnus-simplify-subject (mail-header-subject gnus-headers))))
+ (prog1
+ (gnus-gethash string gnus-agent-spam-hashtb)
+ (gnus-sethash string t gnus-agent-spam-hashtb)))))
+
+(defun gnus-agent-short-p ()
+ "Say whether an article is short or not."
+ (< (mail-header-lines gnus-headers) gnus-agent-short-article))
+
+(defun gnus-agent-long-p ()
+ "Say whether an article is long or not."
+ (> (mail-header-lines gnus-headers) gnus-agent-long-article))
+
+(defun gnus-agent-low-scored-p ()
+ "Say whether an article has a low score or not."
+ (< gnus-score gnus-agent-low-score))
+
+(defun gnus-agent-high-scored-p ()
+ "Say whether an article has a high score or not."
+ (> gnus-score gnus-agent-low-score))
+
+(defun gnus-category-make-function (cat)
+ "Make a function from category CAT."
+ `(lambda () ,(gnus-category-make-function-1 cat)))
+
+(defun gnus-agent-true ()
+ "Return t."
+ t)
+
+(defun gnus-agent-false ()
+ "Return nil."
+ nil)
+
+(defun gnus-category-make-function-1 (cat)
+ "Make a function from category CAT."
+ (cond
+ ;; Functions are just returned as is.
+ ((or (symbolp cat)
+ (gnus-functionp cat))
+ `(,(or (cdr (assq cat gnus-category-predicate-alist))
+ cat)))
+ ;; More complex category.
+ ((consp cat)
+ `(,(cond
+ ((memq (car cat) '(& and))
+ 'and)
+ ((memq (car cat) '(| or))
+ 'or)
+ ((memq (car cat) gnus-category-not)
+ 'not))
+ ,@(mapcar 'gnus-category-make-function-1 (cdr cat))))
+ (t
+ (error "Unknown category type: %s" cat))))
+
+(defun gnus-get-predicate (predicate)
+ "Return the predicate for CATEGORY."
+ (or (cdr (assoc predicate gnus-category-predicate-cache))
+ (cdar (push (cons predicate
+ (gnus-category-make-function predicate))
+ gnus-category-predicate-cache))))
+
+(defun gnus-group-category (group)
+ "Return the category GROUP belongs to."
+ (unless gnus-category-group-cache
+ (setq gnus-category-group-cache (gnus-make-hashtable 1000))
+ (let ((cs gnus-category-alist)
+ groups cat)
+ (while (setq cat (pop cs))
+ (setq groups (cadddr cat))
+ (while groups
+ (gnus-sethash (pop groups) cat gnus-category-group-cache)))))
+ (or (gnus-gethash group gnus-category-group-cache)
+ (assq 'default gnus-category-alist)))
+
+(defun gnus-agent-expire ()
+ "Expire all old articles."
+ (interactive)
+ (let ((methods gnus-agent-covered-methods)
+ (alist (cdr gnus-newsrc-alist))
+ gnus-command-method ofiles info method file group)
+ (while (setq gnus-command-method (pop methods))
+ (setq ofiles (nconc ofiles (gnus-agent-expire-directory
+ (gnus-agent-directory)))))
+ (while (setq info (pop alist))
+ (when (and (gnus-agent-method-p
+ (setq gnus-command-method
+ (gnus-find-method-for-group
+ (setq group (gnus-info-group info)))))
+ (member
+ (setq file
+ (concat
+ (gnus-agent-directory)
+ (gnus-agent-group-path group) "/.overview"))
+ ofiles))
+ (setq ofiles (delete file ofiles))
+ (gnus-agent-expire-group file group)))
+ (while ofiles
+ (gnus-agent-expire-group (pop ofiles)))))
+
+(defun gnus-agent-expire-directory (dir)
+ "Expire all groups in DIR recursively."
+ (when (file-directory-p dir)
+ (let ((files (directory-files dir t))
+ file ofiles)
+ (while (setq file (pop files))
+ (cond
+ ((member (file-name-nondirectory file) '("." ".."))
+ ;; Do nothing.
+ )
+ ((file-directory-p file)
+ ;; Recurse.
+ (setq ofiles (nconc ofiles (gnus-agent-expire-directory file))))
+ ((string-match "\\.overview$" file)
+ ;; Expire group.
+ (push file ofiles))))
+ ofiles)))
+
+(defun gnus-agent-expire-group (overview &optional group)
+ "Expire articles in OVERVIEW."
+ (gnus-message 5 "Expiring %s..." overview)
+ (let ((odate (- (gnus-time-to-day (current-time)) 4))
+ (dir (file-name-directory overview))
+ (info (when group (gnus-get-info group)))
+ headers article file point unreads)
+ (gnus-agent-load-alist nil dir)
+ (when info
+ (setq unreads
+ (nconc
+ (gnus-list-of-unread-articles group)
+ (gnus-uncompress-range
+ (cdr (assq 'tick (gnus-info-marks info))))
+ (gnus-uncompress-range
+ (cdr (assq 'dormant (gnus-info-marks info)))))))
+ (nnheader-temp-write overview
+ (insert-file-contents overview)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq point (point))
+ (condition-case ()
+ (setq headers (inline (nnheader-parse-nov)))
+ (error
+ (goto-char point)
+ (gnus-delete-line)
+ (setq headers nil)))
+ (when headers
+ (unless (memq (setq article (mail-header-number headers)) unreads)
+ (if (not (< (inline
+ (gnus-time-to-day
+ (inline (nnmail-date-to-time
+ (mail-header-date headers)))))
+ odate))
+ (forward-line 1)
+ (gnus-delete-line)
+ (setq gnus-agent-article-alist
+ (delq (assq article gnus-agent-article-alist)
+ gnus-agent-article-alist))
+ (when (file-exists-p
+ (setq file (concat dir (number-to-string article))))
+ (delete-file file))))))
+ (gnus-agent-save-alist nil nil nil dir))))
+
+(provide 'gnus-agent)
+
+;;; gnus-agent.el ends here
--- /dev/null
+;;; gnus-art.el --- article mode commands for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'custom)
+(require 'gnus)
+(require 'gnus-sum)
+(require 'gnus-spec)
+(require 'gnus-int)
+(require 'browse-url)
+
+(defgroup gnus-article nil
+ "Article display."
+ :link '(custom-manual "(gnus)The Article Buffer")
+ :group 'gnus)
+
+(defgroup gnus-article-hiding nil
+ "Hiding article parts."
+ :link '(custom-manual "(gnus)Article Hiding")
+ :group 'gnus-article)
+
+(defgroup gnus-article-highlight nil
+ "Article highlighting."
+ :link '(custom-manual "(gnus)Article Highlighting")
+ :group 'gnus-article
+ :group 'gnus-visual)
+
+(defgroup gnus-article-signature nil
+ "Article signatures."
+ :link '(custom-manual "(gnus)Article Signature")
+ :group 'gnus-article)
+
+(defgroup gnus-article-headers nil
+ "Article headers."
+ :link '(custom-manual "(gnus)Hiding Headers")
+ :group 'gnus-article)
+
+(defgroup gnus-article-washing nil
+ "Special commands on articles."
+ :link '(custom-manual "(gnus)Article Washing")
+ :group 'gnus-article)
+
+(defgroup gnus-article-emphasis nil
+ "Fontisizing articles."
+ :link '(custom-manual "(gnus)Article Fontisizing")
+ :group 'gnus-article)
+
+(defgroup gnus-article-saving nil
+ "Saving articles."
+ :link '(custom-manual "(gnus)Saving Articles")
+ :group 'gnus-article)
+
+(defgroup gnus-article-mime nil
+ "Worshiping the MIME wonder."
+ :link '(custom-manual "(gnus)Using MIME")
+ :group 'gnus-article)
+
+(defgroup gnus-article-buttons nil
+ "Pushable buttons in the article buffer."
+ :link '(custom-manual "(gnus)Article Buttons")
+ :group 'gnus-article)
+
+(defgroup gnus-article-various nil
+ "Other article options."
+ :link '(custom-manual "(gnus)Misc Article")
+ :group 'gnus-article)
+
+(defcustom gnus-ignored-headers
+ '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:"
+ "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:"
+ "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:"
+ "^Approved:" "^Sender:" "^Received:" "^Mail-from:")
+ "All headers that match this regexp will be hidden.
+This variable can also be a list of regexps of headers to be ignored.
+If `gnus-visible-headers' is non-nil, this variable will be ignored."
+ :type '(choice :custom-show nil
+ regexp
+ (repeat regexp))
+ :group 'gnus-article-hiding)
+
+(defcustom gnus-visible-headers
+ "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From"
+ "All headers that do not match this regexp will be hidden.
+This variable can also be a list of regexp of headers to remain visible.
+If this variable is non-nil, `gnus-ignored-headers' will be ignored."
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp)
+ :group 'gnus-article-hiding)
+
+(defcustom gnus-sorted-header-list
+ '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
+ "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
+ "This variable is a list of regular expressions.
+If it is non-nil, headers that match the regular expressions will
+be placed first in the article buffer in the sequence specified by
+this list."
+ :type '(repeat regexp)
+ :group 'gnus-article-hiding)
+
+(defcustom gnus-boring-article-headers '(empty followup-to reply-to)
+ "Headers that are only to be displayed if they have interesting data.
+Possible values in this list are `empty', `newsgroups', `followup-to',
+`reply-to', and `date'."
+ :type '(set (const :tag "Headers with no content." empty)
+ (const :tag "Newsgroups with only one group." newsgroups)
+ (const :tag "Followup-to identical to newsgroups." followup-to)
+ (const :tag "Reply-to identical to from." reply-to)
+ (const :tag "Date less than four days old." date)
+ (const :tag "Very long To header." long-to))
+ :group 'gnus-article-hiding)
+
+(defcustom gnus-signature-separator '("^-- $" "^-- *$")
+ "Regexp matching signature separator.
+This can also be a list of regexps. In that case, it will be checked
+from head to tail looking for a separator. Searches will be done from
+the end of the buffer."
+ :type '(repeat string)
+ :group 'gnus-article-signature)
+
+(defcustom gnus-signature-limit nil
+ "Provide a limit to what is considered a signature.
+If it is a number, no signature may not be longer (in characters) than
+that number. If it is a floating point number, no signature may be
+longer (in lines) than that number. If it is a function, the function
+will be called without any parameters, and if it returns nil, there is
+no signature in the buffer. If it is a string, it will be used as a
+regexp. If it matches, the text in question is not a signature."
+ :type '(choice integer number function regexp)
+ :group 'gnus-article-signature)
+
+(defcustom gnus-hidden-properties '(invisible t intangible t)
+ "Property list to use for hiding text."
+ :type 'sexp
+ :group 'gnus-article-hiding)
+
+(defcustom gnus-article-x-face-command
+ "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
+ "String or function to be executed to display an X-Face header.
+If it is a string, the command will be executed in a sub-shell
+asynchronously. The compressed face will be piped to this command."
+ :type 'string ;Leave function case to Lisp.
+ :group 'gnus-article-washing)
+
+(defcustom gnus-article-x-face-too-ugly nil
+ "Regexp matching posters whose face shouldn't be shown automatically."
+ :type '(choice regexp (const nil))
+ :group 'gnus-article-washing)
+
+(defcustom gnus-emphasis-alist
+ (let ((format
+ "\\(\\s-\\|^\\|[-\"]\\|\\s(\\|\\s)\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-?!.,;:\"]\\|\\s(\\|\\s)\\)")
+ (types
+ '(("_" "_" underline)
+ ("/" "/" italic)
+ ("\\*" "\\*" bold)
+ ("_/" "/_" underline-italic)
+ ("_\\*" "\\*_" underline-bold)
+ ("\\*/" "/\\*" bold-italic)
+ ("_\\*/" "/\\*_" underline-bold-italic))))
+ `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
+ 2 3 gnus-emphasis-underline)
+ ,@(mapcar
+ (lambda (spec)
+ (list
+ (format format (car spec) (cadr spec))
+ 2 3 (intern (format "gnus-emphasis-%s" (caddr spec)))))
+ types)))
+ "Alist that says how to fontify certain phrases.
+Each item looks like this:
+
+ (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
+
+The first element is a regular expression to be matched. The second
+is a number that says what regular expression grouping used to find
+the entire emphasized word. The third is a number that says what
+regexp grouping should be displayed and highlighted. The fourth
+is the face used for highlighting."
+ :type '(repeat (list :value ("" 0 0 default)
+ regexp
+ (integer :tag "Match group")
+ (integer :tag "Emphasize group")
+ face))
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-bold '((t (:bold t)))
+ "Face used for displaying strong emphasized text (*word*)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-italic '((t (:italic t)))
+ "Face used for displaying italic emphasized text (/word/)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-underline '((t (:underline t)))
+ "Face used for displaying underlined emphasized text (_word_)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
+ "Face used for displaying underlined bold emphasized text (_*word*_)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
+ "Face used for displaying underlined italic emphasized text (_*word*_)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
+ "Face used for displaying bold italic emphasized text (/*word*/)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-underline-bold-italic
+ '((t (:bold t :italic t :underline t)))
+ "Face used for displaying underlined bold italic emphasized text.
+Esample: (_/*word*/_)."
+ :group 'gnus-article-emphasis)
+
+(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
+ "Format for display of Date headers in article bodies.
+See `format-time-string' for the possible values."
+ :type 'string
+ :link '(custom-manual "(gnus)Article Date")
+ :group 'gnus-article-washing)
+
+(eval-and-compile
+ (autoload 'hexl-hex-string-to-integer "hexl")
+ (autoload 'timezone-make-date-arpa-standard "timezone")
+ (autoload 'mail-extract-address-components "mail-extr"))
+
+(defcustom gnus-save-all-headers t
+ "*If non-nil, don't remove any headers before saving."
+ :group 'gnus-article-saving
+ :type 'boolean)
+
+(defcustom gnus-prompt-before-saving 'always
+ "*This variable says how much prompting is to be done when saving articles.
+If it is nil, no prompting will be done, and the articles will be
+saved to the default files. If this variable is `always', each and
+every article that is saved will be preceded by a prompt, even when
+saving large batches of articles. If this variable is neither nil not
+`always', there the user will be prompted once for a file name for
+each invocation of the saving commands."
+ :group 'gnus-article-saving
+ :type '(choice (item always)
+ (item :tag "never" nil)
+ (sexp :tag "once" :format "%t")))
+
+(defcustom gnus-saved-headers gnus-visible-headers
+ "Headers to keep if `gnus-save-all-headers' is nil.
+If `gnus-save-all-headers' is non-nil, this variable will be ignored.
+If that variable is nil, however, all headers that match this regexp
+will be kept while the rest will be deleted before saving."
+ :group 'gnus-article-saving
+ :type 'regexp)
+
+(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
+ "A function to save articles in your favourite format.
+The function must be interactively callable (in other words, it must
+be an Emacs command).
+
+Gnus provides the following functions:
+
+* gnus-summary-save-in-rmail (Rmail format)
+* gnus-summary-save-in-mail (Unix mail format)
+* gnus-summary-save-in-folder (MH folder)
+* gnus-summary-save-in-file (article format)
+* gnus-summary-save-in-vm (use VM's folder format)
+* gnus-summary-write-to-file (article format -- overwrite)."
+ :group 'gnus-article-saving
+ :type '(radio (function-item gnus-summary-save-in-rmail)
+ (function-item gnus-summary-save-in-mail)
+ (function-item gnus-summary-save-in-folder)
+ (function-item gnus-summary-save-in-file)
+ (function-item gnus-summary-save-in-vm)
+ (function-item gnus-summary-write-to-file)))
+
+(defcustom gnus-rmail-save-name 'gnus-plain-save-name
+ "A function generating a file name to save articles in Rmail format.
+The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
+ :group 'gnus-article-saving
+ :type 'function)
+
+(defcustom gnus-mail-save-name 'gnus-plain-save-name
+ "A function generating a file name to save articles in Unix mail format.
+The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
+ :group 'gnus-article-saving
+ :type 'function)
+
+(defcustom gnus-folder-save-name 'gnus-folder-save-name
+ "A function generating a file name to save articles in MH folder.
+The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER."
+ :group 'gnus-article-saving
+ :type 'function)
+
+(defcustom gnus-file-save-name 'gnus-numeric-save-name
+ "A function generating a file name to save articles in article format.
+The function is called with NEWSGROUP, HEADERS, and optional
+LAST-FILE."
+ :group 'gnus-article-saving
+ :type 'function)
+
+(defcustom gnus-split-methods
+ '((gnus-article-archive-name)
+ (gnus-article-nndoc-name))
+ "Variable used to suggest where articles are to be saved.
+For instance, if you would like to save articles related to Gnus in
+the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
+you could set this variable to something like:
+
+ '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
+ (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
+
+This variable is an alist where the where the key is the match and the
+value is a list of possible files to save in if the match is non-nil.
+
+If the match is a string, it is used as a regexp match on the
+article. If the match is a symbol, that symbol will be funcalled
+from the buffer of the article to be saved with the newsgroup as the
+parameter. If it is a list, it will be evaled in the same buffer.
+
+If this form or function returns a string, this string will be used as
+a possible file name; and if it returns a non-nil list, that list will
+be used as possible file names."
+ :group 'gnus-article-saving
+ :type '(repeat (choice (list function)
+ (cons regexp (repeat string))
+ sexp)))
+
+(defcustom gnus-strict-mime t
+ "*If nil, MIME-decode even if there is no Mime-Version header."
+ :group 'gnus-article-mime
+ :type 'boolean)
+
+(defcustom gnus-show-mime-method 'metamail-buffer
+ "Function to process a MIME message.
+The function is called from the article buffer."
+ :group 'gnus-article-mime
+ :type 'function)
+
+(defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable
+ "*Function to decode MIME encoded words.
+The function is called from the article buffer."
+ :group 'gnus-article-mime
+ :type 'function)
+
+(defcustom gnus-page-delimiter "^\^L"
+ "*Regexp describing what to use as article page delimiters.
+The default value is \"^\^L\", which is a form linefeed at the
+beginning of a line."
+ :type 'regexp
+ :group 'gnus-article-various)
+
+(defcustom gnus-article-mode-line-format "Gnus: %%b %S"
+ "*The format specification for the article mode line.
+See `gnus-summary-mode-line-format' for a closer description."
+ :type 'string
+ :group 'gnus-article-various)
+
+(defcustom gnus-article-mode-hook nil
+ "*A hook for Gnus article mode."
+ :type 'hook
+ :group 'gnus-article-various)
+
+(defcustom gnus-article-menu-hook nil
+ "*Hook run after the creation of the article mode menu."
+ :type 'hook
+ :group 'gnus-article-various)
+
+(defcustom gnus-article-prepare-hook nil
+ "*A hook called after an article has been prepared in the article buffer.
+If you want to run a special decoding program like nkf, use this hook."
+ :type 'hook
+ :group 'gnus-article-various)
+
+(defcustom gnus-article-hide-pgp-hook nil
+ "*A hook called after successfully hiding a PGP signature."
+ :type 'hook
+ :group 'gnus-article-various)
+
+(defcustom gnus-article-button-face 'bold
+ "Face used for highlighting buttons in the article buffer.
+
+An article button is a piece of text that you can activate by pressing
+`RET' or `mouse-2' above it."
+ :type 'face
+ :group 'gnus-article-buttons)
+
+(defcustom gnus-article-mouse-face 'highlight
+ "Face used for mouse highlighting in the article buffer.
+
+Article buttons will be displayed in this face when the cursor is
+above them."
+ :type 'face
+ :group 'gnus-article-buttons)
+
+(defcustom gnus-signature-face 'gnus-signature-face
+ "Face used for highlighting a signature in the article buffer.
+Obsolete; use the face `gnus-signature-face' for customizations instead."
+ :type 'face
+ :group 'gnus-article-highlight
+ :group 'gnus-article-signature)
+
+(defface gnus-signature-face
+ '((((type x))
+ (:italic t)))
+ "Face used for highlighting a signature in the article buffer."
+ :group 'gnus-article-highlight
+ :group 'gnus-article-signature)
+
+(defface gnus-header-from-face
+ '((((class color)
+ (background dark))
+ (:foreground "spring green" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "red3" :bold t))
+ (t
+ (:bold t :italic t)))
+ "Face used for displaying from headers."
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
+
+(defface gnus-header-subject-face
+ '((((class color)
+ (background dark))
+ (:foreground "SeaGreen3" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "red4" :bold t))
+ (t
+ (:bold t :italic t)))
+ "Face used for displaying subject headers."
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
+
+(defface gnus-header-newsgroups-face
+ '((((class color)
+ (background dark))
+ (:foreground "yellow" :bold t :italic t))
+ (((class color)
+ (background light))
+ (:foreground "MidnightBlue" :bold t :italic t))
+ (t
+ (:bold t :italic t)))
+ "Face used for displaying newsgroups headers."
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
+
+(defface gnus-header-name-face
+ '((((class color)
+ (background dark))
+ (:foreground "SeaGreen"))
+ (((class color)
+ (background light))
+ (:foreground "maroon"))
+ (t
+ (:bold t)))
+ "Face used for displaying header names."
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
+
+(defface gnus-header-content-face
+ '((((class color)
+ (background dark))
+ (:foreground "forest green" :italic t))
+ (((class color)
+ (background light))
+ (:foreground "indianred4" :italic t))
+ (t
+ (:italic t))) "Face used for displaying header content."
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
+
+(defcustom gnus-header-face-alist
+ '(("From" nil gnus-header-from-face)
+ ("Subject" nil gnus-header-subject-face)
+ ("Newsgroups:.*," nil gnus-header-newsgroups-face)
+ ("" gnus-header-name-face gnus-header-content-face))
+ "Controls highlighting of article header.
+
+An alist of the form (HEADER NAME CONTENT).
+
+HEADER is a regular expression which should match the name of an
+header header and NAME and CONTENT are either face names or nil.
+
+The name of each header field will be displayed using the face
+specified by the first element in the list where HEADER match the
+header name and NAME is non-nil. Similarly, the content will be
+displayed by the first non-nil matching CONTENT face."
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight
+ :type '(repeat (list (regexp :tag "Header")
+ (choice :tag "Name"
+ (item :tag "skip" nil)
+ (face :value default))
+ (choice :tag "Content"
+ (item :tag "skip" nil)
+ (face :value default)))))
+
+;;; Internal variables
+
+(defvar gnus-article-mode-syntax-table
+ (let ((table (copy-syntax-table text-mode-syntax-table)))
+ (modify-syntax-entry ?- "w" table)
+ (modify-syntax-entry ?> ")" table)
+ (modify-syntax-entry ?< "(" table)
+ table)
+ "Syntax table used in article mode buffers.
+Initialized from `text-mode-syntax-table.")
+
+(defvar gnus-save-article-buffer nil)
+
+(defvar gnus-article-mode-line-format-alist
+ (nconc '((?w (gnus-article-wash-status) ?s))
+ gnus-summary-mode-line-format-alist))
+
+(defvar gnus-number-of-articles-to-be-saved nil)
+
+(defvar gnus-inhibit-hiding nil)
+
+(defsubst gnus-article-hide-text (b e props)
+ "Set text PROPS on the B to E region, extending `intangible' 1 past B."
+ (add-text-properties b e props)
+ (when (memq 'intangible props)
+ (put-text-property
+ (max (1- b) (point-min))
+ b 'intangible (cddr (memq 'intangible props)))))
+
+(defsubst gnus-article-unhide-text (b e)
+ "Remove hidden text properties from region between B and E."
+ (remove-text-properties b e gnus-hidden-properties)
+ (when (memq 'intangible gnus-hidden-properties)
+ (put-text-property (max (1- b) (point-min))
+ b 'intangible nil)))
+
+(defun gnus-article-hide-text-type (b e type)
+ "Hide text of TYPE between B and E."
+ (gnus-article-hide-text
+ b e (cons 'article-type (cons type gnus-hidden-properties))))
+
+(defun gnus-article-unhide-text-type (b e type)
+ "Hide text of TYPE between B and E."
+ (remove-text-properties
+ b e (cons 'article-type (cons type gnus-hidden-properties)))
+ (when (memq 'intangible gnus-hidden-properties)
+ (put-text-property (max (1- b) (point-min))
+ b 'intangible nil)))
+
+(defun gnus-article-hide-text-of-type (type)
+ "Hide text of TYPE in the current buffer."
+ (save-excursion
+ (let ((b (point-min))
+ (e (point-max)))
+ (while (setq b (text-property-any b e 'article-type type))
+ (add-text-properties b (incf b) gnus-hidden-properties)))))
+
+(defun gnus-article-delete-text-of-type (type)
+ "Delete text of TYPE in the current buffer."
+ (save-excursion
+ (let ((b (point-min)))
+ (while (setq b (text-property-any b (point-max) 'article-type type))
+ (delete-region
+ b (or (text-property-not-all b (point-max) 'article-type type)
+ (point-max)))))))
+
+(defun gnus-article-delete-invisible-text ()
+ "Delete all invisible text in the current buffer."
+ (save-excursion
+ (let ((b (point-min)))
+ (while (setq b (text-property-any b (point-max) 'invisible t))
+ (delete-region
+ b (or (text-property-not-all b (point-max) 'invisible t)
+ (point-max)))))))
+
+(defun gnus-article-text-type-exists-p (type)
+ "Say whether any text of type TYPE exists in the buffer."
+ (text-property-any (point-min) (point-max) 'article-type type))
+
+(defsubst gnus-article-header-rank ()
+ "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
+ (let ((list gnus-sorted-header-list)
+ (i 0))
+ (while list
+ (when (looking-at (car list))
+ (setq list nil))
+ (setq list (cdr list))
+ (incf i))
+ i))
+
+(defun article-hide-headers (&optional arg delete)
+ "Toggle whether to hide unwanted headers and possibly sort them as well.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+ (interactive (gnus-article-hidden-arg))
+ (if (gnus-article-check-hidden-text 'headers arg)
+ ;; Show boring headers as well.
+ (gnus-article-show-hidden-text 'boring-headers)
+ ;; This function might be inhibited.
+ (unless gnus-inhibit-hiding
+ (save-excursion
+ (save-restriction
+ (let ((buffer-read-only nil)
+ (props (nconc (list 'article-type 'headers)
+ gnus-hidden-properties))
+ (max (1+ (length gnus-sorted-header-list)))
+ (ignored (when (not gnus-visible-headers)
+ (cond ((stringp gnus-ignored-headers)
+ gnus-ignored-headers)
+ ((listp gnus-ignored-headers)
+ (mapconcat 'identity gnus-ignored-headers
+ "\\|")))))
+ (visible
+ (cond ((stringp gnus-visible-headers)
+ gnus-visible-headers)
+ ((and gnus-visible-headers
+ (listp gnus-visible-headers))
+ (mapconcat 'identity gnus-visible-headers "\\|"))))
+ (inhibit-point-motion-hooks t)
+ want-list beg)
+ ;; First we narrow to just the headers.
+ (widen)
+ (goto-char (point-min))
+ ;; Hide any "From " lines at the beginning of (mail) articles.
+ (while (looking-at "From ")
+ (forward-line 1))
+ (unless (bobp)
+ (if delete
+ (delete-region (point-min) (point))
+ (gnus-article-hide-text (point-min) (point) props)))
+ ;; Then treat the rest of the header lines.
+ (narrow-to-region
+ (point)
+ (if (search-forward "\n\n" nil t) ; if there's a body
+ (progn (forward-line -1) (point))
+ (point-max)))
+ ;; Then we use the two regular expressions
+ ;; `gnus-ignored-headers' and `gnus-visible-headers' to
+ ;; select which header lines is to remain visible in the
+ ;; article buffer.
+ (goto-char (point-min))
+ (while (re-search-forward "^[^ \t]*:" nil t)
+ (beginning-of-line)
+ ;; Mark the rank of the header.
+ (put-text-property
+ (point) (1+ (point)) 'message-rank
+ (if (or (and visible (looking-at visible))
+ (and ignored
+ (not (looking-at ignored))))
+ (gnus-article-header-rank)
+ (+ 2 max)))
+ (forward-line 1))
+ (message-sort-headers-1)
+ (when (setq beg (text-property-any
+ (point-min) (point-max) 'message-rank (+ 2 max)))
+ ;; We make the unwanted headers invisible.
+ (if delete
+ (delete-region beg (point-max))
+ ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
+ (gnus-article-hide-text-type beg (point-max) 'headers))
+ ;; Work around XEmacs lossage.
+ (put-text-property (point-min) beg 'invisible nil))))))))
+
+(defun article-hide-boring-headers (&optional arg)
+ "Toggle hiding of headers that aren't very interesting.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+ (interactive (gnus-article-hidden-arg))
+ (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
+ (not gnus-show-all-headers))
+ (save-excursion
+ (save-restriction
+ (let ((buffer-read-only nil)
+ (list gnus-boring-article-headers)
+ (inhibit-point-motion-hooks t)
+ elem)
+ (nnheader-narrow-to-headers)
+ (while list
+ (setq elem (pop list))
+ (goto-char (point-min))
+ (cond
+ ;; Hide empty headers.
+ ((eq elem 'empty)
+ (while (re-search-forward "^[^:]+:[ \t]*\n[^ \t]" nil t)
+ (forward-line -1)
+ (gnus-article-hide-text-type
+ (progn (beginning-of-line) (point))
+ (progn
+ (end-of-line)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0)
+ (point-max)))
+ 'boring-headers)))
+ ;; Hide boring Newsgroups header.
+ ((eq elem 'newsgroups)
+ (when (equal (gnus-fetch-field "newsgroups")
+ (gnus-group-real-name
+ (if (boundp 'gnus-newsgroup-name)
+ gnus-newsgroup-name
+ "")))
+ (gnus-article-hide-header "newsgroups")))
+ ((eq elem 'followup-to)
+ (when (equal (message-fetch-field "followup-to")
+ (message-fetch-field "newsgroups"))
+ (gnus-article-hide-header "followup-to")))
+ ((eq elem 'reply-to)
+ (let ((from (message-fetch-field "from"))
+ (reply-to (message-fetch-field "reply-to")))
+ (when (and
+ from reply-to
+ (ignore-errors
+ (equal
+ (nth 1 (mail-extract-address-components from))
+ (nth 1 (mail-extract-address-components reply-to)))))
+ (gnus-article-hide-header "reply-to"))))
+ ((eq elem 'date)
+ (let ((date (message-fetch-field "date")))
+ (when (and date
+ (< (gnus-days-between (current-time-string) date)
+ 4))
+ (gnus-article-hide-header "date"))))
+ ((eq elem 'long-to)
+ (let ((to (message-fetch-field "to")))
+ (when (> (length to) 1024)
+ (gnus-article-hide-header "to")))))))))))
+
+(defun gnus-article-hide-header (header)
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^" header ":") nil t)
+ (gnus-article-hide-text-type
+ (progn (beginning-of-line) (point))
+ (progn
+ (end-of-line)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0)
+ (point-max)))
+ 'boring-headers))))
+
+;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
+(defun article-treat-overstrike ()
+ "Translate overstrikes into bold text."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (let ((buffer-read-only nil))
+ (while (search-forward "\b" nil t)
+ (let ((next (following-char))
+ (previous (char-after (- (point) 2))))
+ ;; We do the boldification/underlining by hiding the
+ ;; overstrikes and putting the proper text property
+ ;; on the letters.
+ (cond
+ ((eq next previous)
+ (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
+ (put-text-property (point) (1+ (point)) 'face 'bold))
+ ((eq next ?_)
+ (gnus-article-hide-text-type
+ (1- (point)) (1+ (point)) 'overstrike)
+ (put-text-property
+ (- (point) 2) (1- (point)) 'face 'underline))
+ ((eq previous ?_)
+ (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
+ (put-text-property
+ (point) (1+ (point)) 'face 'underline)))))))))
+
+(defun article-fill ()
+ "Format too long lines."
+ (interactive)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (widen)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (end-of-line 1)
+ (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
+ (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
+ (adaptive-fill-mode t))
+ (while (not (eobp))
+ (and (>= (current-column) (min fill-column (window-width)))
+ (/= (preceding-char) ?:)
+ (fill-paragraph nil))
+ (end-of-line 2))))))
+
+(defun article-remove-cr ()
+ "Remove carriage returns from an article."
+ (interactive)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t)))))
+
+(defun article-remove-trailing-blank-lines ()
+ "Remove all trailing blank lines from the article."
+ (interactive)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (goto-char (point-max))
+ (delete-region
+ (point)
+ (progn
+ (while (and (not (bobp))
+ (looking-at "^[ \t]*$"))
+ (forward-line -1))
+ (forward-line 1)
+ (point))))))
+
+(defun article-display-x-face (&optional force)
+ "Look for an X-Face header and display it if present."
+ (interactive (list 'force))
+ (save-excursion
+ ;; Delete the old process, if any.
+ (when (process-status "article-x-face")
+ (delete-process "article-x-face"))
+ (let ((inhibit-point-motion-hooks t)
+ (case-fold-search nil)
+ from)
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (setq from (message-fetch-field "from"))
+ (goto-char (point-min))
+ (while (and gnus-article-x-face-command
+ (or force
+ ;; Check whether this face is censored.
+ (not gnus-article-x-face-too-ugly)
+ (and gnus-article-x-face-too-ugly from
+ (not (string-match gnus-article-x-face-too-ugly
+ from))))
+ ;; Has to be present.
+ (re-search-forward "^X-Face: " nil t))
+ ;; We now have the area of the buffer where the X-Face is stored.
+ (save-excursion
+ (let ((beg (point))
+ (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
+ ;; We display the face.
+ (if (symbolp gnus-article-x-face-command)
+ ;; The command is a lisp function, so we call it.
+ (if (gnus-functionp gnus-article-x-face-command)
+ (funcall gnus-article-x-face-command beg end)
+ (error "%s is not a function" gnus-article-x-face-command))
+ ;; The command is a string, so we interpret the command
+ ;; as a, well, command, and fork it off.
+ (let ((process-connection-type nil))
+ (process-kill-without-query
+ (start-process
+ "article-x-face" nil shell-file-name shell-command-switch
+ gnus-article-x-face-command))
+ (process-send-region "article-x-face" beg end)
+ (process-send-eof "article-x-face"))))))))))
+
+(defun gnus-hack-decode-rfc1522 ()
+ "Emergency hack function for avoiding problems when decoding."
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ ;; Remove encoded TABs.
+ (while (search-forward "=09" nil t)
+ (replace-match " " t t))
+ ;; Remove encoded newlines.
+ (goto-char (point-min))
+ (while (search-forward "=10" nil t)
+ (replace-match " " t t))))
+
+(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
+(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
+(defun article-decode-rfc1522 ()
+ "Hack to remove QP encoding from headers."
+ (let ((case-fold-search t)
+ (inhibit-point-motion-hooks t)
+ (buffer-read-only nil)
+ string)
+ (save-restriction
+ (narrow-to-region
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
+ (setq string (match-string 1))
+ (save-restriction
+ (narrow-to-region (match-beginning 0) (match-end 0))
+ (delete-region (point-min) (point-max))
+ (insert string)
+ (article-mime-decode-quoted-printable
+ (goto-char (point-min)) (point-max))
+ (subst-char-in-region (point-min) (point-max) ?_ ? )
+ (goto-char (point-max)))
+ (goto-char (point-min))))))
+
+(defun article-de-quoted-unreadable (&optional force)
+ "Do a naive translation of a quoted-printable-encoded article.
+This is in no way, shape or form meant as a replacement for real MIME
+processing, but is simply a stop-gap measure until MIME support is
+written.
+If FORCE, decode the article whether it is marked as quoted-printable
+or not."
+ (interactive (list 'force))
+ (save-excursion
+ (let ((case-fold-search t)
+ (buffer-read-only nil)
+ (type (gnus-fetch-field "content-transfer-encoding")))
+ (gnus-article-decode-rfc1522)
+ (when (or force
+ (and type (string-match "quoted-printable" (downcase type))))
+ (goto-char (point-min))
+ (search-forward "\n\n" nil 'move)
+ (article-mime-decode-quoted-printable (point) (point-max))))))
+
+(defun article-mime-decode-quoted-printable-buffer ()
+ "Decode Quoted-Printable in the current buffer."
+ (article-mime-decode-quoted-printable (point-min) (point-max)))
+
+(defun article-mime-decode-quoted-printable (from to)
+ "Decode Quoted-Printable in the region between FROM and TO."
+ (interactive "r")
+ (goto-char from)
+ (while (search-forward "=" to t)
+ (cond ((eq (following-char) ?\n)
+ (delete-char -1)
+ (delete-char 1))
+ ((looking-at "[0-9A-F][0-9A-F]")
+ (subst-char-in-region
+ (1- (point)) (point) ?=
+ (hexl-hex-string-to-integer
+ (buffer-substring (point) (+ 2 (point)))))
+ (delete-char 2))
+ ((looking-at "=")
+ (delete-char 1))
+ ((gnus-message 3 "Malformed MIME quoted-printable message")))))
+
+(defun article-hide-pgp (&optional arg)
+ "Toggle hiding of any PGP headers and signatures in the current article.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+ (interactive (gnus-article-hidden-arg))
+ (unless (gnus-article-check-hidden-text 'pgp arg)
+ (save-excursion
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only beg end)
+ (widen)
+ (goto-char (point-min))
+ ;; Hide the "header".
+ (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
+ (gnus-article-hide-text-type (1+ (match-beginning 0))
+ (match-end 0) 'pgp)
+ (setq beg (point))
+ ;; Hide the actual signature.
+ (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
+ (setq end (1+ (match-beginning 0)))
+ (gnus-article-hide-text-type
+ end
+ (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
+ (match-end 0)
+ ;; Perhaps we shouldn't hide to the end of the buffer
+ ;; if there is no end to the signature?
+ (point-max))
+ 'pgp))
+ ;; Hide "- " PGP quotation markers.
+ (when (and beg end)
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (re-search-forward "^- " nil t)
+ (gnus-article-hide-text-type
+ (match-beginning 0) (match-end 0) 'pgp))
+ (widen))
+ (run-hooks 'gnus-article-hide-pgp-hook))))))
+
+(defun article-hide-pem (&optional arg)
+ "Toggle hiding of any PEM headers and signatures in the current article.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+ (interactive (gnus-article-hidden-arg))
+ (unless (gnus-article-check-hidden-text 'pem arg)
+ (save-excursion
+ (let (buffer-read-only end)
+ (widen)
+ (goto-char (point-min))
+ ;; hide the horrendously ugly "header".
+ (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
+ nil
+ t)
+ (setq end (1+ (match-beginning 0)))
+ (gnus-article-hide-text-type
+ end
+ (if (search-forward "\n\n" nil t)
+ (match-end 0)
+ (point-max))
+ 'pem))
+ ;; hide the trailer as well
+ (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n"
+ nil
+ t)
+ (gnus-article-hide-text-type
+ (match-beginning 0) (match-end 0) 'pem))))))
+
+(defun article-hide-signature (&optional arg)
+ "Hide the signature in the current article.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+ (interactive (gnus-article-hidden-arg))
+ (unless (gnus-article-check-hidden-text 'signature arg)
+ (save-excursion
+ (save-restriction
+ (let ((buffer-read-only nil))
+ (when (gnus-article-narrow-to-signature)
+ (gnus-article-hide-text-type
+ (point-min) (point-max) 'signature)))))))
+
+(defun article-strip-leading-blank-lines ()
+ "Remove all blank lines from the beginning of the article."
+ (interactive)
+ (save-excursion
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (while (and (not (eobp))
+ (looking-at "[ \t]*$"))
+ (gnus-delete-line))))))
+
+(defun article-strip-multiple-blank-lines ()
+ "Replace consecutive blank lines with one empty line."
+ (interactive)
+ (save-excursion
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
+ ;; First make all blank lines empty.
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (while (re-search-forward "^[ \t]+$" nil t)
+ (replace-match "" nil t))
+ ;; Then replace multiple empty lines with a single empty line.
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (while (re-search-forward "\n\n\n+" nil t)
+ (replace-match "\n\n" t t)))))
+
+(defun article-strip-leading-space ()
+ "Remove all white space from the beginning of the lines in the article."
+ (interactive)
+ (save-excursion
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (while (re-search-forward "^[ \t]+" nil t)
+ (replace-match "" t t)))))
+
+(defun article-strip-blank-lines ()
+ "Strip leading, trailing and multiple blank lines."
+ (interactive)
+ (article-strip-leading-blank-lines)
+ (article-remove-trailing-blank-lines)
+ (article-strip-multiple-blank-lines))
+
+(defvar mime::preview/content-list)
+(defvar mime::preview-content-info/point-min)
+(defun gnus-article-narrow-to-signature ()
+ "Narrow to the signature; return t if a signature is found, else nil."
+ (widen)
+ (when (and (boundp 'mime::preview/content-list)
+ mime::preview/content-list)
+ ;; We have a MIMEish article, so we use the MIME data to narrow.
+ (let ((pcinfo (car (last mime::preview/content-list))))
+ (ignore-errors
+ (narrow-to-region
+ (funcall (intern "mime::preview-content-info/point-min") pcinfo)
+ (point-max)))))
+
+ (when (gnus-article-search-signature)
+ (forward-line 1)
+ ;; Check whether we have some limits to what we consider
+ ;; to be a signature.
+ (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
+ (list gnus-signature-limit)))
+ limit limited)
+ (while (setq limit (pop limits))
+ (if (or (and (integerp limit)
+ (< (- (point-max) (point)) limit))
+ (and (floatp limit)
+ (< (count-lines (point) (point-max)) limit))
+ (and (gnus-functionp limit)
+ (funcall limit))
+ (and (stringp limit)
+ (not (re-search-forward limit nil t))))
+ () ; This limit did not succeed.
+ (setq limited t
+ limits nil)))
+ (unless limited
+ (narrow-to-region (point) (point-max))
+ t))))
+
+(defun gnus-article-search-signature ()
+ "Search the current buffer for the signature separator.
+Put point at the beginning of the signature separator."
+ (let ((cur (point)))
+ (goto-char (point-max))
+ (if (if (stringp gnus-signature-separator)
+ (re-search-backward gnus-signature-separator nil t)
+ (let ((seps gnus-signature-separator))
+ (while (and seps
+ (not (re-search-backward (car seps) nil t)))
+ (pop seps))
+ seps))
+ t
+ (goto-char cur)
+ nil)))
+
+(eval-and-compile
+ (autoload 'w3-display "w3-parse")
+ (autoload 'w3-do-setup "w3" "" t)
+ (autoload 'w3-region "w3-display" "" t))
+
+(defun gnus-article-treat-html ()
+ "Render HTML."
+ (interactive)
+ (let ((cbuf (current-buffer)))
+ (set-buffer gnus-article-buffer)
+ (let (buf buffer-read-only b e)
+ (w3-do-setup)
+ (goto-char (point-min))
+ (narrow-to-region
+ (if (search-forward "\n\n" nil t)
+ (setq b (point))
+ (point-max))
+ (setq e (point-max)))
+ (nnheader-temp-write nil
+ (insert-buffer-substring gnus-article-buffer b e)
+ (require 'url)
+ (save-window-excursion
+ (w3-region (point-min) (point-max))
+ (setq buf (buffer-substring-no-properties (point-min) (point-max)))))
+ (when buf
+ (delete-region (point-min) (point-max))
+ (insert buf))
+ (widen)
+ (goto-char (point-min))
+ (set-window-start (get-buffer-window (current-buffer)) (point-min))
+ (set-buffer cbuf))))
+
+(defun gnus-article-hidden-arg ()
+ "Return the current prefix arg as a number, or 0 if no prefix."
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 0)))
+
+(defun gnus-article-check-hidden-text (type arg)
+ "Return nil if hiding is necessary.
+Arg can be nil or a number. Nil and positive means hide, negative
+means show, 0 means toggle."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((hide (gnus-article-hidden-text-p type)))
+ (cond
+ ((or (null arg)
+ (> arg 0))
+ nil)
+ ((< arg 0)
+ (gnus-article-show-hidden-text type))
+ (t
+ (if (eq hide 'hidden)
+ (gnus-article-show-hidden-text type)
+ nil)))))))
+
+(defun gnus-article-hidden-text-p (type)
+ "Say whether the current buffer contains hidden text of type TYPE."
+ (let ((start (point-min))
+ (pos (text-property-any (point-min) (point-max) 'article-type type)))
+ (while (and pos
+ (not (get-text-property pos 'invisible)))
+ (setq pos
+ (text-property-any (1+ pos) (point-max) 'article-type type)))
+ (if pos
+ 'hidden
+ 'shown)))
+
+(defun gnus-article-show-hidden-text (type &optional hide)
+ "Show all hidden text of type TYPE.
+If HIDE, hide the text instead."
+ (save-excursion
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (end (point-min))
+ beg)
+ (while (setq beg (text-property-any end (point-max) 'article-type type))
+ (goto-char beg)
+ (setq end (or
+ (text-property-not-all beg (point-max) 'article-type type)
+ (point-max)))
+ (if hide
+ (gnus-article-hide-text beg end gnus-hidden-properties)
+ (gnus-article-unhide-text beg end))
+ (goto-char end))
+ t)))
+
+(defconst article-time-units
+ `((year . ,(* 365.25 24 60 60))
+ (week . ,(* 7 24 60 60))
+ (day . ,(* 24 60 60))
+ (hour . ,(* 60 60))
+ (minute . 60)
+ (second . 1))
+ "Mapping from time units to seconds.")
+
+(defun article-date-ut (&optional type highlight header)
+ "Convert DATE date to universal time in the current article.
+If TYPE is `local', convert to local time; if it is `lapsed', output
+how much time has lapsed since DATE."
+ (interactive (list 'ut t))
+ (let* ((header (or header
+ (mail-header-date gnus-current-headers)
+ (message-fetch-field "date")
+ ""))
+ (date (if (vectorp header) (mail-header-date header)
+ header))
+ (date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
+ (inhibit-point-motion-hooks t)
+ bface eface)
+ (when (and date (not (string= date "")))
+ (save-excursion
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (let ((buffer-read-only nil))
+ ;; Delete any old Date headers.
+ (if (re-search-forward date-regexp nil t)
+ (progn
+ (setq bface (get-text-property (gnus-point-at-bol) 'face)
+ eface (get-text-property (1- (gnus-point-at-eol))
+ 'face))
+ (message-remove-header date-regexp t)
+ (beginning-of-line))
+ (goto-char (point-max)))
+ (insert (article-make-date-line date type))
+ ;; Do highlighting.
+ (forward-line -1)
+ (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face bface)
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'face eface))))))))
+
+(defun article-make-date-line (date type)
+ "Return a DATE line of TYPE."
+ (cond
+ ;; Convert to the local timezone. We have to slap a
+ ;; `condition-case' round the calls to the timezone
+ ;; functions since they aren't particularly resistant to
+ ;; buggy dates.
+ ((eq type 'local)
+ (concat "Date: " (condition-case ()
+ (timezone-make-date-arpa-standard date)
+ (error date))
+ "\n"))
+ ;; Convert to Universal Time.
+ ((eq type 'ut)
+ (concat "Date: "
+ (condition-case ()
+ (timezone-make-date-arpa-standard date nil "UT")
+ (error date))
+ "\n"))
+ ;; Get the original date from the article.
+ ((eq type 'original)
+ (concat "Date: " date "\n"))
+ ;; Let the user define the format.
+ ((eq type 'user)
+ (concat
+ "Date: "
+ (format-time-string gnus-article-time-format
+ (ignore-errors
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT"))))
+ "\n"))
+ ;; Do an X-Sent lapsed format.
+ ((eq type 'lapsed)
+ ;; If the date is seriously mangled, the timezone functions are
+ ;; liable to bug out, so we ignore all errors.
+ (let* ((now (current-time))
+ (real-time
+ (ignore-errors
+ (gnus-time-minus
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ (current-time-string now)
+ (current-time-zone now) "UT"))
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT")))))
+ (real-sec (and real-time
+ (+ (* (float (car real-time)) 65536)
+ (cadr real-time))))
+ (sec (and real-time (abs real-sec)))
+ num prev)
+ (cond
+ ((null real-time)
+ "X-Sent: Unknown\n")
+ ((zerop sec)
+ "X-Sent: Now\n")
+ (t
+ (concat
+ "X-Sent: "
+ ;; This is a bit convoluted, but basically we go
+ ;; through the time units for years, weeks, etc,
+ ;; and divide things to see whether that results
+ ;; in positive answers.
+ (mapconcat
+ (lambda (unit)
+ (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
+ ;; The (remaining) seconds are too few to
+ ;; be divided into this time unit.
+ ""
+ ;; It's big enough, so we output it.
+ (setq sec (- sec (* num (cdr unit))))
+ (prog1
+ (concat (if prev ", " "") (int-to-string
+ (floor num))
+ " " (symbol-name (car unit))
+ (if (> num 1) "s" ""))
+ (setq prev t))))
+ article-time-units "")
+ ;; If dates are odd, then it might appear like the
+ ;; article was sent in the future.
+ (if (> real-sec 0)
+ " ago\n"
+ " in the future\n"))))))
+ (t
+ (error "Unknown conversion type: %s" type))))
+
+(defun article-date-local (&optional highlight)
+ "Convert the current article date to the local timezone."
+ (interactive (list t))
+ (article-date-ut 'local highlight))
+
+(defun article-date-original (&optional highlight)
+ "Convert the current article date to what it was originally.
+This is only useful if you have used some other date conversion
+function and want to see what the date was before converting."
+ (interactive (list t))
+ (article-date-ut 'original highlight))
+
+(defun article-date-lapsed (&optional highlight)
+ "Convert the current article date to time lapsed since it was sent."
+ (interactive (list t))
+ (article-date-ut 'lapsed highlight))
+
+(defun article-date-user (&optional highlight)
+ "Convert the current article date to the user-defined format.
+This format is defined by the `gnus-article-time-format' variable."
+ (interactive (list t))
+ (article-date-ut 'user highlight))
+
+(defun article-show-all ()
+ "Show all hidden text in the article buffer."
+ (interactive)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (gnus-article-unhide-text (point-min) (point-max)))))
+
+(defun article-emphasize (&optional arg)
+ "Emphasize text according to `gnus-emphasis-alist'."
+ (interactive (gnus-article-hidden-arg))
+ (unless (gnus-article-check-hidden-text 'emphasis arg)
+ (save-excursion
+ (let ((alist gnus-emphasis-alist)
+ (buffer-read-only nil)
+ (props (append '(article-type emphasis)
+ gnus-hidden-properties))
+ regexp elem beg invisible visible face)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (setq beg (point))
+ (while (setq elem (pop alist))
+ (goto-char beg)
+ (setq regexp (car elem)
+ invisible (nth 1 elem)
+ visible (nth 2 elem)
+ face (nth 3 elem))
+ (while (re-search-forward regexp nil t)
+ (when (and (match-beginning visible) (match-beginning invisible))
+ (gnus-article-hide-text
+ (match-beginning invisible) (match-end invisible) props)
+ (gnus-article-unhide-text-type
+ (match-beginning visible) (match-end visible) 'emphasis)
+ (gnus-put-text-property-excluding-newlines
+ (match-beginning visible) (match-end visible) 'face face)
+ (goto-char (match-end invisible)))))))))
+
+(defvar gnus-summary-article-menu)
+(defvar gnus-summary-post-menu)
+
+;;; Saving functions.
+
+(defun gnus-article-save (save-buffer file &optional num)
+ "Save the currently selected article."
+ (unless gnus-save-all-headers
+ ;; Remove headers according to `gnus-saved-headers'.
+ (let ((gnus-visible-headers
+ (or gnus-saved-headers gnus-visible-headers))
+ (gnus-article-buffer save-buffer))
+ (gnus-article-hide-headers 1 t)))
+ (save-window-excursion
+ (if (not gnus-default-article-saver)
+ (error "No default saver is defined")
+ ;; !!! Magic! The saving functions all save
+ ;; `gnus-original-article-buffer' (or so they think), but we
+ ;; bind that variable to our save-buffer.
+ (set-buffer gnus-article-buffer)
+ (let* ((gnus-save-article-buffer save-buffer)
+ (filename
+ (cond
+ ((not gnus-prompt-before-saving) 'default)
+ ((eq gnus-prompt-before-saving 'always) nil)
+ (t file)))
+ (gnus-number-of-articles-to-be-saved
+ (when (eq gnus-prompt-before-saving t)
+ num))) ; Magic
+ (set-buffer gnus-summary-buffer)
+ (funcall gnus-default-article-saver filename)))))
+
+(defun gnus-read-save-file-name (prompt &optional filename
+ function group headers variable)
+ (let ((default-name
+ (funcall function group headers (symbol-value variable)))
+ result)
+ (setq
+ result
+ (cond
+ ((eq filename 'default)
+ default-name)
+ ((eq filename t)
+ default-name)
+ (filename filename)
+ (t
+ (let* ((split-name (gnus-get-split-value gnus-split-methods))
+ (prompt
+ (format prompt
+ (if (and gnus-number-of-articles-to-be-saved
+ (> gnus-number-of-articles-to-be-saved 1))
+ (format "these %d articles"
+ gnus-number-of-articles-to-be-saved)
+ "this article")))
+ (file
+ ;; Let the split methods have their say.
+ (cond
+ ;; No split name was found.
+ ((null split-name)
+ (read-file-name
+ (concat prompt " (default "
+ (file-name-nondirectory default-name) ") ")
+ (file-name-directory default-name)
+ default-name))
+ ;; A single group name is returned.
+ ((stringp split-name)
+ (setq default-name
+ (funcall function split-name headers
+ (symbol-value variable)))
+ (read-file-name
+ (concat prompt " (default "
+ (file-name-nondirectory default-name) ") ")
+ (file-name-directory default-name)
+ default-name))
+ ;; A single split name was found
+ ((= 1 (length split-name))
+ (let* ((name (expand-file-name
+ (car split-name) gnus-article-save-directory))
+ (dir (cond ((file-directory-p name)
+ (file-name-as-directory name))
+ ((file-exists-p name) name)
+ (t gnus-article-save-directory))))
+ (read-file-name
+ (concat prompt " (default " name ") ")
+ dir name)))
+ ;; A list of splits was found.
+ (t
+ (setq split-name (nreverse split-name))
+ (let (result)
+ (let ((file-name-history
+ (nconc split-name file-name-history)))
+ (setq result
+ (expand-file-name
+ (read-file-name
+ (concat prompt " (`M-p' for defaults) ")
+ gnus-article-save-directory
+ (car split-name))
+ gnus-article-save-directory)))
+ (car (push result file-name-history)))))))
+ ;; Create the directory.
+ (gnus-make-directory (file-name-directory file))
+ ;; If we have read a directory, we append the default file name.
+ (when (file-directory-p file)
+ (setq file (concat (file-name-as-directory file)
+ (file-name-nondirectory default-name))))
+ ;; Possibly translate some characters.
+ (nnheader-translate-file-chars file)))))
+ (gnus-make-directory (file-name-directory result))
+ (set variable result)))
+
+(defun gnus-article-archive-name (group)
+ "Return the first instance of an \"Archive-name\" in the current buffer."
+ (let ((case-fold-search t))
+ (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
+ (nnheader-concat gnus-article-save-directory
+ (match-string 1)))))
+
+(defun gnus-article-nndoc-name (group)
+ "If GROUP is an nndoc group, return the name of the parent group."
+ (when (eq (car (gnus-find-method-for-group group)) 'nndoc)
+ (gnus-group-get-parameter group 'save-article-group)))
+
+(defun gnus-summary-save-in-rmail (&optional filename)
+ "Append this article to Rmail file.
+Optional argument FILENAME specifies file name.
+Directory to save to is default to `gnus-article-save-directory'."
+ (interactive)
+ (gnus-set-global-variables)
+ (setq filename (gnus-read-save-file-name
+ "Save %s in rmail file:" filename
+ gnus-rmail-save-name gnus-newsgroup-name
+ gnus-current-headers 'gnus-newsgroup-last-rmail))
+ (gnus-eval-in-buffer-window gnus-save-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (gnus-output-to-rmail filename)))))
+
+(defun gnus-summary-save-in-mail (&optional filename)
+ "Append this article to Unix mail file.
+Optional argument FILENAME specifies file name.
+Directory to save to is default to `gnus-article-save-directory'."
+ (interactive)
+ (gnus-set-global-variables)
+ (setq filename (gnus-read-save-file-name
+ "Save %s in Unix mail file:" filename
+ gnus-mail-save-name gnus-newsgroup-name
+ gnus-current-headers 'gnus-newsgroup-last-mail))
+ (gnus-eval-in-buffer-window gnus-save-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (if (and (file-readable-p filename)
+ (mail-file-babyl-p filename))
+ (gnus-output-to-rmail filename t)
+ (gnus-output-to-mail filename))))))
+
+(defun gnus-summary-save-in-file (&optional filename overwrite)
+ "Append this article to file.
+Optional argument FILENAME specifies file name.
+Directory to save to is default to `gnus-article-save-directory'."
+ (interactive)
+ (gnus-set-global-variables)
+ (setq filename (gnus-read-save-file-name
+ "Save %s in file:" filename
+ gnus-file-save-name gnus-newsgroup-name
+ gnus-current-headers 'gnus-newsgroup-last-file))
+ (gnus-eval-in-buffer-window gnus-save-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (when (and overwrite
+ (file-exists-p filename))
+ (delete-file filename))
+ (gnus-output-to-file filename)))))
+
+(defun gnus-summary-write-to-file (&optional filename)
+ "Write this article to a file.
+Optional argument FILENAME specifies file name.
+The directory to save in defaults to `gnus-article-save-directory'."
+ (interactive)
+ (gnus-summary-save-in-file nil t))
+
+(defun gnus-summary-save-body-in-file (&optional filename)
+ "Append this article body to a file.
+Optional argument FILENAME specifies file name.
+The directory to save in defaults to `gnus-article-save-directory'."
+ (interactive)
+ (gnus-set-global-variables)
+ (setq filename (gnus-read-save-file-name
+ "Save %s body in file:" filename
+ gnus-file-save-name gnus-newsgroup-name
+ gnus-current-headers 'gnus-newsgroup-last-file))
+ (gnus-eval-in-buffer-window gnus-save-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (narrow-to-region (point) (point-max)))
+ (gnus-output-to-file filename)))))
+
+(defun gnus-summary-save-in-pipe (&optional command)
+ "Pipe this article to subprocess."
+ (interactive)
+ (gnus-set-global-variables)
+ (setq command
+ (cond ((eq command 'default)
+ gnus-last-shell-command)
+ (command command)
+ (t (read-string
+ (format
+ "Shell command on %s: "
+ (if (and gnus-number-of-articles-to-be-saved
+ (> gnus-number-of-articles-to-be-saved 1))
+ (format "these %d articles"
+ gnus-number-of-articles-to-be-saved)
+ "this article"))
+ gnus-last-shell-command))))
+ (when (string-equal command "")
+ (setq command gnus-last-shell-command))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (shell-command-on-region (point-min) (point-max) command nil)))
+ (setq gnus-last-shell-command command))
+
+;;; Article file names when saving.
+
+(defun gnus-capitalize-newsgroup (newsgroup)
+ "Capitalize NEWSGROUP name."
+ (when (not (zerop (length newsgroup)))
+ (concat (char-to-string (upcase (aref newsgroup 0)))
+ (substring newsgroup 1))))
+
+(defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
+ "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
+If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group/num.
+Otherwise, it is like ~/News/news/group/num."
+ (let ((default
+ (expand-file-name
+ (concat (if (gnus-use-long-file-name 'not-save)
+ (gnus-capitalize-newsgroup newsgroup)
+ (gnus-newsgroup-directory-form newsgroup))
+ "/" (int-to-string (mail-header-number headers)))
+ gnus-article-save-directory)))
+ (if (and last-file
+ (string-equal (file-name-directory default)
+ (file-name-directory last-file))
+ (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
+ default
+ (or last-file default))))
+
+(defun gnus-numeric-save-name (newsgroup headers &optional last-file)
+ "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
+If variable `gnus-use-long-file-name' is non-nil, it is
+~/News/news.group/num. Otherwise, it is like ~/News/news/group/num."
+ (let ((default
+ (expand-file-name
+ (concat (if (gnus-use-long-file-name 'not-save)
+ newsgroup
+ (gnus-newsgroup-directory-form newsgroup))
+ "/" (int-to-string (mail-header-number headers)))
+ gnus-article-save-directory)))
+ (if (and last-file
+ (string-equal (file-name-directory default)
+ (file-name-directory last-file))
+ (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
+ default
+ (or last-file default))))
+
+(defun gnus-Plain-save-name (newsgroup headers &optional last-file)
+ "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
+If variable `gnus-use-long-file-name' is non-nil, it is
+~/News/News.group. Otherwise, it is like ~/News/news/group/news."
+ (or last-file
+ (expand-file-name
+ (if (gnus-use-long-file-name 'not-save)
+ (gnus-capitalize-newsgroup newsgroup)
+ (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
+ gnus-article-save-directory)))
+
+(defun gnus-plain-save-name (newsgroup headers &optional last-file)
+ "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
+If variable `gnus-use-long-file-name' is non-nil, it is
+~/News/news.group. Otherwise, it is like ~/News/news/group/news."
+ (or last-file
+ (expand-file-name
+ (if (gnus-use-long-file-name 'not-save)
+ newsgroup
+ (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
+ gnus-article-save-directory)))
+
+(eval-and-compile
+ (mapcar
+ (lambda (func)
+ (let (afunc gfunc)
+ (if (consp func)
+ (setq afunc (car func)
+ gfunc (cdr func))
+ (setq afunc func
+ gfunc (intern (format "gnus-%s" func))))
+ (fset gfunc
+ (if (not (fboundp afunc))
+ nil
+ `(lambda (&optional interactive &rest args)
+ ,(documentation afunc t)
+ (interactive (list t))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (if interactive
+ (call-interactively ',afunc)
+ (apply ',afunc args))))))))
+ '(article-hide-headers
+ article-hide-boring-headers
+ article-treat-overstrike
+ (article-fill . gnus-article-word-wrap)
+ article-remove-cr
+ article-display-x-face
+ article-de-quoted-unreadable
+ article-mime-decode-quoted-printable
+ article-hide-pgp
+ article-hide-pem
+ article-hide-signature
+ article-remove-trailing-blank-lines
+ article-strip-leading-blank-lines
+ article-strip-multiple-blank-lines
+ article-strip-leading-space
+ article-strip-blank-lines
+ article-date-local
+ article-date-original
+ article-date-ut
+ article-date-user
+ article-date-lapsed
+ article-emphasize
+ (article-show-all . gnus-article-show-all-headers))))
+\f
+;;;
+;;; Gnus article mode
+;;;
+
+(put 'gnus-article-mode 'mode-class 'special)
+
+(gnus-define-keys gnus-article-mode-map
+ " " gnus-article-goto-next-page
+ "\177" gnus-article-goto-prev-page
+ [delete] gnus-article-goto-prev-page
+ "\C-c^" gnus-article-refer-article
+ "h" gnus-article-show-summary
+ "s" gnus-article-show-summary
+ "\C-c\C-m" gnus-article-mail
+ "?" gnus-article-describe-briefly
+ gnus-mouse-2 gnus-article-push-button
+ "\r" gnus-article-press-button
+ "\t" gnus-article-next-button
+ "\M-\t" gnus-article-prev-button
+ "e" gnus-article-edit
+ "<" beginning-of-buffer
+ ">" end-of-buffer
+ "\C-c\C-i" gnus-info-find-node
+ "\C-c\C-b" gnus-bug
+
+ "\C-d" gnus-article-read-summary-keys
+ "\M-*" gnus-article-read-summary-keys
+ "\M-#" gnus-article-read-summary-keys
+ "\M-^" gnus-article-read-summary-keys
+ "\M-g" gnus-article-read-summary-keys)
+
+(substitute-key-definition
+ 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
+
+(defun gnus-article-make-menu-bar ()
+ (gnus-turn-off-edit-menu 'article)
+ (unless (boundp 'gnus-article-article-menu)
+ (easy-menu-define
+ gnus-article-article-menu gnus-article-mode-map ""
+ '("Article"
+ ["Scroll forwards" gnus-article-goto-next-page t]
+ ["Scroll backwards" gnus-article-goto-prev-page t]
+ ["Show summary" gnus-article-show-summary t]
+ ["Fetch Message-ID at point" gnus-article-refer-article t]
+ ["Mail to address at point" gnus-article-mail t]))
+
+ (easy-menu-define
+ gnus-article-treatment-menu gnus-article-mode-map ""
+ '("Treatment"
+ ["Hide headers" gnus-article-hide-headers t]
+ ["Hide signature" gnus-article-hide-signature t]
+ ["Hide citation" gnus-article-hide-citation t]
+ ["Treat overstrike" gnus-article-treat-overstrike t]
+ ["Remove carriage return" gnus-article-remove-cr t]
+ ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]))
+
+ (when nil
+ (when (boundp 'gnus-summary-article-menu)
+ (define-key gnus-article-mode-map [menu-bar commands]
+ (cons "Commands" gnus-summary-article-menu))))
+
+ (when (boundp 'gnus-summary-post-menu)
+ (define-key gnus-article-mode-map [menu-bar post]
+ (cons "Post" gnus-summary-post-menu)))
+
+ (run-hooks 'gnus-article-menu-hook)))
+
+(defun gnus-article-mode ()
+ "Major mode for displaying an article.
+
+All normal editing commands are switched off.
+
+The following commands are available in addition to all summary mode
+commands:
+\\<gnus-article-mode-map>
+\\[gnus-article-next-page]\t Scroll the article one page forwards
+\\[gnus-article-prev-page]\t Scroll the article one page backwards
+\\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
+\\[gnus-article-show-summary]\t Display the summary buffer
+\\[gnus-article-mail]\t Send a reply to the address near point
+\\[gnus-article-describe-briefly]\t Describe the current mode briefly
+\\[gnus-info-find-node]\t Go to the Gnus info node"
+ (interactive)
+ (when (gnus-visual-p 'article-menu 'menu)
+ (gnus-article-make-menu-bar))
+ (kill-all-local-variables)
+ (gnus-simplify-mode-line)
+ (setq mode-name "Article")
+ (setq major-mode 'gnus-article-mode)
+ (make-local-variable 'minor-mode-alist)
+ (unless (assq 'gnus-show-mime minor-mode-alist)
+ (push (list 'gnus-show-mime " MIME") minor-mode-alist))
+ (use-local-map gnus-article-mode-map)
+ (gnus-update-format-specifications nil 'article-mode)
+ (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
+ (set (make-local-variable 'gnus-page-broken) nil)
+ (set (make-local-variable 'gnus-button-marker-list) nil)
+ (gnus-set-default-directory)
+ (buffer-disable-undo (current-buffer))
+ (setq buffer-read-only t)
+ (set-syntax-table gnus-article-mode-syntax-table)
+ (run-hooks 'gnus-article-mode-hook))
+
+(defun gnus-article-setup-buffer ()
+ "Initialize the article buffer."
+ (let* ((name (if gnus-single-article-buffer "*Article*"
+ (concat "*Article " gnus-newsgroup-name "*")))
+ (original
+ (progn (string-match "\\*Article" name)
+ (concat " *Original Article"
+ (substring name (match-end 0))))))
+ (setq gnus-article-buffer name)
+ (setq gnus-original-article-buffer original)
+ ;; This might be a variable local to the summary buffer.
+ (unless gnus-single-article-buffer
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (setq gnus-article-buffer name)
+ (setq gnus-original-article-buffer original)
+ (gnus-set-global-variables)))
+ ;; Init original article buffer.
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-original-article-buffer))
+ (buffer-disable-undo (current-buffer))
+ (setq major-mode 'gnus-original-article-mode)
+ (gnus-add-current-to-buffer-list)
+ (make-local-variable 'gnus-original-article))
+ (if (get-buffer name)
+ (save-excursion
+ (set-buffer name)
+ (buffer-disable-undo (current-buffer))
+ (setq buffer-read-only t)
+ (gnus-add-current-to-buffer-list)
+ (unless (eq major-mode 'gnus-article-mode)
+ (gnus-article-mode))
+ (current-buffer))
+ (save-excursion
+ (set-buffer (get-buffer-create name))
+ (gnus-add-current-to-buffer-list)
+ (gnus-article-mode)
+ (make-local-variable 'gnus-summary-buffer)
+ (current-buffer)))))
+
+;; Set article window start at LINE, where LINE is the number of lines
+;; from the head of the article.
+(defun gnus-article-set-window-start (&optional line)
+ (set-window-start
+ (get-buffer-window gnus-article-buffer t)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char (point-min))
+ (if (not line)
+ (point-min)
+ (gnus-message 6 "Moved to bookmark")
+ (search-forward "\n\n" nil t)
+ (forward-line line)
+ (point)))))
+
+(defun gnus-article-prepare (article &optional all-headers header)
+ "Prepare ARTICLE in article mode buffer.
+ARTICLE should either be an article number or a Message-ID.
+If ARTICLE is an id, HEADER should be the article headers.
+If ALL-HEADERS is non-nil, no headers are hidden."
+ (save-excursion
+ ;; Make sure we start in a summary buffer.
+ (unless (eq major-mode 'gnus-summary-mode)
+ (set-buffer gnus-summary-buffer))
+ (setq gnus-summary-buffer (current-buffer))
+ ;; Make sure the connection to the server is alive.
+ (unless (gnus-server-opened
+ (gnus-find-method-for-group gnus-newsgroup-name))
+ (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
+ (gnus-request-group gnus-newsgroup-name t))
+ (let* ((gnus-article (if header (mail-header-number header) article))
+ (summary-buffer (current-buffer))
+ (internal-hook gnus-article-internal-prepare-hook)
+ (group gnus-newsgroup-name)
+ result)
+ (save-excursion
+ (gnus-article-setup-buffer)
+ (set-buffer gnus-article-buffer)
+ ;; Deactivate active regions.
+ (when (and (boundp 'transient-mark-mode)
+ transient-mark-mode)
+ (setq mark-active nil))
+ (if (not (setq result (let ((buffer-read-only nil))
+ (gnus-request-article-this-buffer
+ article group))))
+ ;; There is no such article.
+ (save-excursion
+ (when (and (numberp article)
+ (not (memq article gnus-newsgroup-sparse)))
+ (setq gnus-article-current
+ (cons gnus-newsgroup-name article))
+ (set-buffer gnus-summary-buffer)
+ (setq gnus-current-article article)
+ (gnus-summary-mark-article article gnus-canceled-mark))
+ (unless (memq article gnus-newsgroup-sparse)
+ (gnus-error
+ 1 "No such article (may have expired or been canceled)")))
+ (if (or (eq result 'pseudo) (eq result 'nneething))
+ (progn
+ (save-excursion
+ (set-buffer summary-buffer)
+ (setq gnus-last-article gnus-current-article
+ gnus-newsgroup-history (cons gnus-current-article
+ gnus-newsgroup-history)
+ gnus-current-article 0
+ gnus-current-headers nil
+ gnus-article-current nil)
+ (if (eq result 'nneething)
+ (gnus-configure-windows 'summary)
+ (gnus-configure-windows 'article))
+ (gnus-set-global-variables))
+ (gnus-set-mode-line 'article))
+ ;; The result from the `request' was an actual article -
+ ;; or at least some text that is now displayed in the
+ ;; article buffer.
+ (when (and (numberp article)
+ (not (eq article gnus-current-article)))
+ ;; Seems like a new article has been selected.
+ ;; `gnus-current-article' must be an article number.
+ (save-excursion
+ (set-buffer summary-buffer)
+ (setq gnus-last-article gnus-current-article
+ gnus-newsgroup-history (cons gnus-current-article
+ gnus-newsgroup-history)
+ gnus-current-article article
+ gnus-current-headers
+ (gnus-summary-article-header gnus-current-article)
+ gnus-article-current
+ (cons gnus-newsgroup-name gnus-current-article))
+ (unless (vectorp gnus-current-headers)
+ (setq gnus-current-headers nil))
+ (gnus-summary-goto-subject gnus-current-article)
+ (gnus-summary-show-thread)
+ (run-hooks 'gnus-mark-article-hook)
+ (gnus-set-mode-line 'summary)
+ (when (gnus-visual-p 'article-highlight 'highlight)
+ (run-hooks 'gnus-visual-mark-article-hook))
+ ;; Set the global newsgroup variables here.
+ ;; Suggested by Jim Sisolak
+ ;; <sisolak@trans4.neep.wisc.edu>.
+ (gnus-set-global-variables)
+ (setq gnus-have-all-headers
+ (or all-headers gnus-show-all-headers))
+ (and gnus-use-cache
+ (vectorp (gnus-summary-article-header article))
+ (gnus-cache-possibly-enter-article
+ group article
+ (gnus-summary-article-header article)
+ (memq article gnus-newsgroup-marked)
+ (memq article gnus-newsgroup-dormant)
+ (memq article gnus-newsgroup-unreads)))))
+ (when (or (numberp article)
+ (stringp article))
+ ;; Hooks for getting information from the article.
+ ;; This hook must be called before being narrowed.
+ (let (buffer-read-only)
+ (run-hooks 'internal-hook)
+ (run-hooks 'gnus-article-prepare-hook)
+ ;; Decode MIME message.
+ (when gnus-show-mime
+ (if (or (not gnus-strict-mime)
+ (gnus-fetch-field "Mime-Version"))
+ (funcall gnus-show-mime-method)
+ (funcall gnus-decode-encoded-word-method)))
+ ;; Perform the article display hooks.
+ (run-hooks 'gnus-article-display-hook))
+ ;; Do page break.
+ (goto-char (point-min))
+ (setq gnus-page-broken
+ (when gnus-break-pages
+ (gnus-narrow-to-page)
+ t)))
+ (gnus-set-mode-line 'article)
+ (gnus-configure-windows 'article)
+ (goto-char (point-min))
+ t))))))
+
+(defun gnus-article-wash-status ()
+ "Return a string which display status of article washing."
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((cite (gnus-article-hidden-text-p 'cite))
+ (headers (gnus-article-hidden-text-p 'headers))
+ (boring (gnus-article-hidden-text-p 'boring-headers))
+ (pgp (gnus-article-hidden-text-p 'pgp))
+ (pem (gnus-article-hidden-text-p 'pem))
+ (signature (gnus-article-hidden-text-p 'signature))
+ (overstrike (gnus-article-hidden-text-p 'overstrike))
+ (emphasis (gnus-article-hidden-text-p 'emphasis))
+ (mime gnus-show-mime))
+ (format "%c%c%c%c%c%c%c"
+ (if cite ?c ? )
+ (if (or headers boring) ?h ? )
+ (if (or pgp pem) ?p ? )
+ (if signature ?s ? )
+ (if overstrike ?o ? )
+ (if mime ?m ? )
+ (if emphasis ?e ? )))))
+
+(defun gnus-article-hide-headers-if-wanted ()
+ "Hide unwanted headers if `gnus-have-all-headers' is nil.
+Provided for backwards compatibility."
+ (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
+ gnus-inhibit-hiding
+ (gnus-article-hide-headers)))
+
+;;; Article savers.
+
+(defun gnus-output-to-file (file-name)
+ "Append the current article to a file named FILE-NAME."
+ (let ((artbuf (current-buffer)))
+ (nnheader-temp-write nil
+ (insert-buffer-substring artbuf)
+ ;; Append newline at end of the buffer as separator, and then
+ ;; save it to file.
+ (goto-char (point-max))
+ (insert "\n")
+ (append-to-file (point-min) (point-max) file-name)
+ t)))
+
+(defun gnus-narrow-to-page (&optional arg)
+ "Narrow the article buffer to a page.
+If given a numerical ARG, move forward ARG pages."
+ (interactive "P")
+ (setq arg (if arg (prefix-numeric-value arg) 0))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char (point-min))
+ (widen)
+ ;; Remove any old next/prev buttons.
+ (when (gnus-visual-p 'page-marker)
+ (let ((buffer-read-only nil))
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)))
+ (when
+ (cond ((< arg 0)
+ (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
+ ((> arg 0)
+ (re-search-forward page-delimiter nil 'move arg)))
+ (goto-char (match-end 0)))
+ (narrow-to-region
+ (point)
+ (if (re-search-forward page-delimiter nil 'move)
+ (match-beginning 0)
+ (point)))
+ (when (and (gnus-visual-p 'page-marker)
+ (not (= (point-min) 1)))
+ (save-excursion
+ (goto-char (point-min))
+ (gnus-insert-prev-page-button)))
+ (when (and (gnus-visual-p 'page-marker)
+ (< (+ (point-max) 2) (buffer-size)))
+ (save-excursion
+ (goto-char (point-max))
+ (gnus-insert-next-page-button)))))
+
+;; Article mode commands
+
+(defun gnus-article-goto-next-page ()
+ "Show the next page of the article."
+ (interactive)
+ (when (gnus-article-next-page)
+ (goto-char (point-min))
+ (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
+
+(defun gnus-article-goto-prev-page ()
+ "Show the next page of the article."
+ (interactive)
+ (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
+ (gnus-article-prev-page nil)))
+
+(defun gnus-article-next-page (&optional lines)
+ "Show the next page of the current article.
+If end of article, return non-nil. Otherwise return nil.
+Argument LINES specifies lines to be scrolled up."
+ (interactive "p")
+ (move-to-window-line -1)
+ (if (save-excursion
+ (end-of-line)
+ (and (pos-visible-in-window-p) ;Not continuation line.
+ (eobp)))
+ ;; Nothing in this page.
+ (if (or (not gnus-page-broken)
+ (save-excursion
+ (save-restriction
+ (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
+ t ;Nothing more.
+ (gnus-narrow-to-page 1) ;Go to next page.
+ nil)
+ ;; More in this page.
+ (let ((scroll-in-place nil))
+ (condition-case ()
+ (scroll-up lines)
+ (end-of-buffer
+ ;; Long lines may cause an end-of-buffer error.
+ (goto-char (point-max)))))
+ (move-to-window-line 0)
+ nil))
+
+(defun gnus-article-prev-page (&optional lines)
+ "Show previous page of current article.
+Argument LINES specifies lines to be scrolled down."
+ (interactive "p")
+ (move-to-window-line 0)
+ (if (and gnus-page-broken
+ (bobp)
+ (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
+ (progn
+ (gnus-narrow-to-page -1) ;Go to previous page.
+ (goto-char (point-max))
+ (recenter -1))
+ (let ((scroll-in-place nil))
+ (prog1
+ (condition-case ()
+ (scroll-down lines)
+ (beginning-of-buffer
+ (goto-char (point-min))))
+ (move-to-window-line 0)))))
+
+(defun gnus-article-refer-article ()
+ "Read article specified by message-id around point."
+ (interactive)
+ (let ((point (point)))
+ (search-forward ">" nil t) ;Move point to end of "<....>".
+ (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
+ (let ((message-id (match-string 1)))
+ (goto-char point)
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-refer-article message-id))
+ (goto-char (point))
+ (error "No references around point"))))
+
+(defun gnus-article-show-summary ()
+ "Reconfigure windows to show summary buffer."
+ (interactive)
+ (if (not (gnus-buffer-live-p gnus-summary-buffer))
+ (error "There is no summary buffer for this article buffer")
+ (gnus-article-set-globals)
+ (gnus-configure-windows 'article)
+ (gnus-summary-goto-subject gnus-current-article)))
+
+(defun gnus-article-describe-briefly ()
+ "Describe article mode commands briefly."
+ (interactive)
+ (gnus-message 6
+ (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
+
+(defun gnus-article-summary-command ()
+ "Execute the last keystroke in the summary buffer."
+ (interactive)
+ (let ((obuf (current-buffer))
+ (owin (current-window-configuration))
+ func)
+ (switch-to-buffer gnus-summary-buffer 'norecord)
+ (setq func (lookup-key (current-local-map) (this-command-keys)))
+ (call-interactively func)
+ (set-buffer obuf)
+ (set-window-configuration owin)
+ (set-window-point (get-buffer-window (current-buffer)) (point))))
+
+(defun gnus-article-summary-command-nosave ()
+ "Execute the last keystroke in the summary buffer."
+ (interactive)
+ (let (func)
+ (pop-to-buffer gnus-summary-buffer 'norecord)
+ (setq func (lookup-key (current-local-map) (this-command-keys)))
+ (call-interactively func)))
+
+(defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
+ "Read a summary buffer key sequence and execute it from the article buffer."
+ (interactive "P")
+ (let ((nosaves
+ '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
+ "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
+ "=" "^" "\M-^" "|"))
+ (nosave-but-article
+ '("A\r"))
+ (nosave-in-article
+ '("\C-d"))
+ keys)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let (gnus-pick-mode)
+ (push (or key last-command-event) unread-command-events)
+ (setq keys (read-key-sequence nil))))
+ (message "")
+
+ (if (or (member keys nosaves)
+ (member keys nosave-but-article)
+ (member keys nosave-in-article))
+ (let (func)
+ (save-window-excursion
+ (pop-to-buffer gnus-summary-buffer 'norecord)
+ ;; We disable the pick minor mode commands.
+ (let (gnus-pick-mode)
+ (setq func (lookup-key (current-local-map) keys))))
+ (if (not func)
+ (ding)
+ (unless (member keys nosave-in-article)
+ (set-buffer gnus-summary-buffer))
+ (call-interactively func))
+ (when (member keys nosave-but-article)
+ (pop-to-buffer gnus-article-buffer 'norecord)))
+ ;; These commands should restore window configuration.
+ (let ((obuf (current-buffer))
+ (owin (current-window-configuration))
+ (opoint (point))
+ func in-buffer)
+ (if not-restore-window
+ (pop-to-buffer gnus-summary-buffer 'norecord)
+ (switch-to-buffer gnus-summary-buffer 'norecord))
+ (setq in-buffer (current-buffer))
+ ;; We disable the pick minor mode commands.
+ (if (setq func (let (gnus-pick-mode)
+ (lookup-key (current-local-map) keys)))
+ (call-interactively func)
+ (ding))
+ (when (eq in-buffer (current-buffer))
+ (set-buffer obuf)
+ (unless not-restore-window
+ (set-window-configuration owin))
+ (set-window-point (get-buffer-window (current-buffer)) opoint))))))
+
+(defun gnus-article-hide (&optional arg force)
+ "Hide all the gruft in the current article.
+This means that PGP stuff, signatures, cited text and (some)
+headers will be hidden.
+If given a prefix, show the hidden text instead."
+ (interactive (list current-prefix-arg 'force))
+ (gnus-article-hide-headers arg)
+ (gnus-article-hide-pgp arg)
+ (gnus-article-hide-citation-maybe arg force)
+ (gnus-article-hide-signature arg))
+
+(defun gnus-article-maybe-highlight ()
+ "Do some article highlighting if `article-visual' is non-nil."
+ (when (gnus-visual-p 'article-highlight 'highlight)
+ (gnus-article-highlight-some)))
+
+(defun gnus-request-article-this-buffer (article group)
+ "Get an article and insert it into this buffer."
+ (let (do-update-line)
+ (prog1
+ (save-excursion
+ (erase-buffer)
+ (gnus-kill-all-overlays)
+ (setq group (or group gnus-newsgroup-name))
+
+ ;; Open server if it has closed.
+ (gnus-check-server (gnus-find-method-for-group group))
+
+ ;; Using `gnus-request-article' directly will insert the article into
+ ;; `nntp-server-buffer' - so we'll save some time by not having to
+ ;; copy it from the server buffer into the article buffer.
+
+ ;; We only request an article by message-id when we do not have the
+ ;; headers for it, so we'll have to get those.
+ (when (stringp article)
+ (let ((gnus-override-method gnus-refer-article-method))
+ (gnus-read-header article)))
+
+ ;; If the article number is negative, that means that this article
+ ;; doesn't belong in this newsgroup (possibly), so we find its
+ ;; message-id and request it by id instead of number.
+ (when (and (numberp article)
+ gnus-summary-buffer
+ (get-buffer gnus-summary-buffer)
+ (buffer-name (get-buffer gnus-summary-buffer)))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let ((header (gnus-summary-article-header article)))
+ (when (< article 0)
+ (cond
+ ((memq article gnus-newsgroup-sparse)
+ ;; This is a sparse gap article.
+ (setq do-update-line article)
+ (setq article (mail-header-id header))
+ (let ((gnus-override-method gnus-refer-article-method))
+ (gnus-read-header article))
+ (setq gnus-newsgroup-sparse
+ (delq article gnus-newsgroup-sparse)))
+ ((vectorp header)
+ ;; It's a real article.
+ (setq article (mail-header-id header)))
+ (t
+ ;; It is an extracted pseudo-article.
+ (setq article 'pseudo)
+ (gnus-request-pseudo-article header))))
+
+ (let ((method (gnus-find-method-for-group
+ gnus-newsgroup-name)))
+ (if (not (eq (car method) 'nneething))
+ ()
+ (let ((dir (concat (file-name-as-directory (nth 1 method))
+ (mail-header-subject header))))
+ (when (file-directory-p dir)
+ (setq article 'nneething)
+ (gnus-group-enter-directory dir))))))))
+
+ (cond
+ ;; Refuse to select canceled articles.
+ ((and (numberp article)
+ gnus-summary-buffer
+ (get-buffer gnus-summary-buffer)
+ (buffer-name (get-buffer gnus-summary-buffer))
+ (eq (cdr (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (assq article gnus-newsgroup-reads)))
+ gnus-canceled-mark))
+ nil)
+ ;; We first check `gnus-original-article-buffer'.
+ ((and (get-buffer gnus-original-article-buffer)
+ (numberp article)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (and (equal (car gnus-original-article) group)
+ (eq (cdr gnus-original-article) article))))
+ (insert-buffer-substring gnus-original-article-buffer)
+ 'article)
+ ;; Check the backlog.
+ ((and gnus-keep-backlog
+ (gnus-backlog-request-article group article (current-buffer)))
+ 'article)
+ ;; Check asynchronous pre-fetch.
+ ((gnus-async-request-fetched-article group article (current-buffer))
+ (gnus-async-prefetch-next group article gnus-summary-buffer)
+ 'article)
+ ;; Check the cache.
+ ((and gnus-use-cache
+ (numberp article)
+ (gnus-cache-request-article article group))
+ 'article)
+ ;; Get the article and put into the article buffer.
+ ((or (stringp article) (numberp article))
+ (let ((gnus-override-method
+ (and (stringp article) gnus-refer-article-method))
+ (buffer-read-only nil))
+ (erase-buffer)
+ (gnus-kill-all-overlays)
+ (when (gnus-request-article article group (current-buffer))
+ (when (numberp article)
+ (gnus-async-prefetch-next group article gnus-summary-buffer)
+ (when gnus-keep-backlog
+ (gnus-backlog-enter-article
+ group article (current-buffer))))
+ 'article)))
+ ;; It was a pseudo.
+ (t article)))
+
+ ;; Take the article from the original article buffer
+ ;; and place it in the buffer it's supposed to be in.
+ (when (and (get-buffer gnus-article-buffer)
+ ;;(numberp article)
+ (equal (buffer-name (current-buffer))
+ (buffer-name (get-buffer gnus-article-buffer))))
+ (save-excursion
+ (if (get-buffer gnus-original-article-buffer)
+ (set-buffer (get-buffer gnus-original-article-buffer))
+ (set-buffer (get-buffer-create gnus-original-article-buffer))
+ (buffer-disable-undo (current-buffer))
+ (setq major-mode 'gnus-original-article-mode)
+ (setq buffer-read-only t)
+ (gnus-add-current-to-buffer-list))
+ (let (buffer-read-only)
+ (erase-buffer)
+ (insert-buffer-substring gnus-article-buffer))
+ (setq gnus-original-article (cons group article))))
+
+ ;; Update sparse articles.
+ (when (and do-update-line
+ (or (numberp article)
+ (stringp article)))
+ (let ((buf (current-buffer)))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-update-article do-update-line)
+ (gnus-summary-goto-subject do-update-line nil t)
+ (set-window-point (get-buffer-window (current-buffer) t)
+ (point))
+ (set-buffer buf))))))
+
+;;;
+;;; Article editing
+;;;
+
+(defcustom gnus-article-edit-mode-hook nil
+ "Hook run in article edit mode buffers."
+ :group 'gnus-article-various
+ :type 'hook)
+
+(defvar gnus-article-edit-done-function nil)
+
+(defvar gnus-article-edit-mode-map nil)
+
+(unless gnus-article-edit-mode-map
+ (setq gnus-article-edit-mode-map (copy-keymap text-mode-map))
+
+ (gnus-define-keys gnus-article-edit-mode-map
+ "\C-c\C-c" gnus-article-edit-done
+ "\C-c\C-k" gnus-article-edit-exit)
+
+ (gnus-define-keys (gnus-article-edit-wash-map
+ "\C-c\C-w" gnus-article-edit-mode-map)
+ "f" gnus-article-edit-full-stops))
+
+(defun gnus-article-edit-mode ()
+ "Major mode for editing articles.
+This is an extended text-mode.
+
+\\{gnus-article-edit-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'gnus-article-edit-mode)
+ (setq mode-name "Article Edit")
+ (use-local-map gnus-article-edit-mode-map)
+ (make-local-variable 'gnus-article-edit-done-function)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq buffer-read-only nil)
+ (buffer-enable-undo)
+ (widen)
+ (run-hooks 'text-mode 'gnus-article-edit-mode-hook))
+
+(defun gnus-article-edit (&optional force)
+ "Edit the current article.
+This will have permanent effect only in mail groups.
+If FORCE is non-nil, allow editing of articles even in read-only
+groups."
+ (interactive "P")
+ (when (and (not force)
+ (gnus-group-read-only-p))
+ (error "The current newsgroup does not support article editing"))
+ (gnus-article-edit-article
+ `(lambda (no-highlight)
+ (gnus-summary-edit-article-done
+ ,(or (mail-header-references gnus-current-headers) "")
+ ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))
+
+(defun gnus-article-edit-article (exit-func)
+ "Start editing the contents of the current article buffer."
+ (let ((winconf (current-window-configuration)))
+ (set-buffer gnus-article-buffer)
+ (gnus-article-edit-mode)
+ (gnus-set-text-properties (point-min) (point-max) nil)
+ (gnus-configure-windows 'edit-article)
+ (setq gnus-article-edit-done-function exit-func)
+ (setq gnus-prev-winconf winconf)
+ (gnus-message 6 "C-c C-c to end edits")))
+
+(defun gnus-article-edit-done (&optional arg)
+ "Update the article edits and exit."
+ (interactive "P")
+ (let ((func gnus-article-edit-done-function)
+ (buf (current-buffer))
+ (start (window-start)))
+ (gnus-article-edit-exit)
+ (save-excursion
+ (set-buffer buf)
+ (let ((buffer-read-only nil))
+ (funcall func arg)))
+ (set-buffer buf)
+ (set-window-start (get-buffer-window buf) start)
+ (set-window-point (get-buffer-window buf) (point))))
+
+(defun gnus-article-edit-exit ()
+ "Exit the article editing without updating."
+ (interactive)
+ ;; We remove all text props from the article buffer.
+ (let ((buf (format "%s" (buffer-string)))
+ (curbuf (current-buffer))
+ (p (point))
+ (window-start (window-start)))
+ (erase-buffer)
+ (insert buf)
+ (let ((winconf gnus-prev-winconf))
+ (gnus-article-mode)
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ ;; Flush original article as well.
+ (save-excursion
+ (when (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (setq gnus-original-article nil)))
+ (set-window-configuration winconf)
+ ;; Tippy-toe some to make sure that point remains where it was.
+ (let ((buf (current-buffer)))
+ (set-buffer curbuf)
+ (set-window-start (get-buffer-window (current-buffer)) window-start)
+ (goto-char p)
+ (set-buffer buf)))))
+
+(defun gnus-article-edit-full-stops ()
+ "Interactively repair spacing at end of sentences."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward-regexp "^$" nil t)
+ (let ((case-fold-search nil))
+ (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2"))))
+
+;;;
+;;; Article highlights
+;;;
+
+;; Written by Per Abrahamsen <abraham@iesd.auc.dk>.
+
+;;; Internal Variables:
+
+(defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)"
+ "Regular expression that matches URLs."
+ :group 'gnus-article-buttons
+ :type 'regexp)
+
+(defcustom gnus-button-alist
+ `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t
+ gnus-button-message-id 2)
+ ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1)
+ ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
+ gnus-button-fetch-group 4)
+ ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
+ ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
+ t gnus-button-message-id 3)
+ ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
+ ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
+ ;; This is how URLs _should_ be embedded in text...
+ ("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1)
+ ;; Raw URLs.
+ (,gnus-button-url-regexp 0 t gnus-button-url 0))
+ "Alist of regexps matching buttons in article bodies.
+
+Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
+REGEXP: is the string matching text around the button,
+BUTTON: is the number of the regexp grouping actually matching the button,
+FORM: is a lisp expression which must eval to true for the button to
+be added,
+CALLBACK: is the function to call when the user push this button, and each
+PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
+
+CALLBACK can also be a variable, in that case the value of that
+variable it the real callback function."
+ :group 'gnus-article-buttons
+ :type '(repeat (list regexp
+ (integer :tag "Button")
+ (sexp :tag "Form")
+ (function :tag "Callback")
+ (repeat :tag "Par"
+ :inline t
+ (integer :tag "Regexp group")))))
+
+(defcustom gnus-header-button-alist
+ `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
+ 0 t gnus-button-message-id 0)
+ ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1)
+ ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
+ 0 t gnus-button-mailto 0)
+ ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
+ ("^Subject:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
+ ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
+ ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
+ gnus-button-message-id 3))
+ "Alist of headers and regexps to match buttons in article heads.
+
+This alist is very similar to `gnus-button-alist', except that each
+alist has an additional HEADER element first in each entry:
+
+\(HEADER REGEXP BUTTON FORM CALLBACK PAR)
+
+HEADER is a regexp to match a header. For a fuller explanation, see
+`gnus-button-alist'."
+ :group 'gnus-article-buttons
+ :group 'gnus-article-headers
+ :type '(repeat (list (regexp :tag "Header")
+ regexp
+ (integer :tag "Button")
+ (sexp :tag "Form")
+ (function :tag "Callback")
+ (repeat :tag "Par"
+ :inline t
+ (integer :tag "Regexp group")))))
+
+(defvar gnus-button-regexp nil)
+(defvar gnus-button-marker-list nil)
+;; Regexp matching any of the regexps from `gnus-button-alist'.
+
+(defvar gnus-button-last nil)
+;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
+
+;;; Commands:
+
+(defun gnus-article-push-button (event)
+ "Check text under the mouse pointer for a callback function.
+If the text under the mouse pointer has a `gnus-callback' property,
+call it with the value of the `gnus-data' text property."
+ (interactive "e")
+ (set-buffer (window-buffer (posn-window (event-start event))))
+ (let* ((pos (posn-point (event-start event)))
+ (data (get-text-property pos 'gnus-data))
+ (fun (get-text-property pos 'gnus-callback)))
+ (when fun
+ (funcall fun data))))
+
+(defun gnus-article-press-button ()
+ "Check text at point for a callback function.
+If the text at point has a `gnus-callback' property,
+call it with the value of the `gnus-data' text property."
+ (interactive)
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (fun (get-text-property (point) 'gnus-callback)))
+ (when fun
+ (funcall fun data))))
+
+(defun gnus-article-prev-button (n)
+ "Move point to N buttons backward.
+If N is negative, move forward instead."
+ (interactive "p")
+ (gnus-article-next-button (- n)))
+
+(defun gnus-article-next-button (n)
+ "Move point to N buttons forward.
+If N is negative, move backward instead."
+ (interactive "p")
+ (let ((function (if (< n 0) 'previous-single-property-change
+ 'next-single-property-change))
+ (inhibit-point-motion-hooks t)
+ (backward (< n 0))
+ (limit (if (< n 0) (point-min) (point-max))))
+ (setq n (abs n))
+ (while (and (not (= limit (point)))
+ (> n 0))
+ ;; Skip past the current button.
+ (when (get-text-property (point) 'gnus-callback)
+ (goto-char (funcall function (point) 'gnus-callback nil limit)))
+ ;; Go to the next (or previous) button.
+ (gnus-goto-char (funcall function (point) 'gnus-callback nil limit))
+ ;; Put point at the start of the button.
+ (when (and backward (not (get-text-property (point) 'gnus-callback)))
+ (goto-char (funcall function (point) 'gnus-callback nil limit)))
+ ;; Skip past intangible buttons.
+ (when (get-text-property (point) 'intangible)
+ (incf n))
+ (decf n))
+ (unless (zerop n)
+ (gnus-message 5 "No more buttons"))
+ n))
+
+(defun gnus-article-highlight (&optional force)
+ "Highlight current article.
+This function calls `gnus-article-highlight-headers',
+`gnus-article-highlight-citation',
+`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
+do the highlighting. See the documentation for those functions."
+ (interactive (list 'force))
+ (gnus-article-highlight-headers)
+ (gnus-article-highlight-citation force)
+ (gnus-article-highlight-signature)
+ (gnus-article-add-buttons force)
+ (gnus-article-add-buttons-to-head))
+
+(defun gnus-article-highlight-some (&optional force)
+ "Highlight current article.
+This function calls `gnus-article-highlight-headers',
+`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
+do the highlighting. See the documentation for those functions."
+ (interactive (list 'force))
+ (gnus-article-highlight-headers)
+ (gnus-article-highlight-signature)
+ (gnus-article-add-buttons))
+
+(defun gnus-article-highlight-headers ()
+ "Highlight article headers as specified by `gnus-header-face-alist'."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (save-restriction
+ (let ((alist gnus-header-face-alist)
+ (buffer-read-only nil)
+ (case-fold-search t)
+ (inhibit-point-motion-hooks t)
+ entry regexp header-face field-face from hpoints fpoints)
+ (message-narrow-to-head)
+ (while (setq entry (pop alist))
+ (goto-char (point-min))
+ (setq regexp (concat "^\\("
+ (if (string-equal "" (nth 0 entry))
+ "[^\t ]"
+ (nth 0 entry))
+ "\\)")
+ header-face (nth 1 entry)
+ field-face (nth 2 entry))
+ (while (and (re-search-forward regexp nil t)
+ (not (eobp)))
+ (beginning-of-line)
+ (setq from (point))
+ (unless (search-forward ":" nil t)
+ (forward-char 1))
+ (when (and header-face
+ (not (memq (point) hpoints)))
+ (push (point) hpoints)
+ (gnus-put-text-property from (point) 'face header-face))
+ (when (and field-face
+ (not (memq (setq from (point)) fpoints)))
+ (push from fpoints)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (forward-char -2)
+ (goto-char (point-max)))
+ (gnus-put-text-property from (point) 'face field-face))))))))
+
+(defun gnus-article-highlight-signature ()
+ "Highlight the signature in an article.
+It does this by highlighting everything after
+`gnus-signature-separator' using `gnus-signature-face'."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t))
+ (save-restriction
+ (when (and gnus-signature-face
+ (gnus-article-narrow-to-signature))
+ (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
+ 'face gnus-signature-face)
+ (widen)
+ (gnus-article-search-signature)
+ (let ((start (match-beginning 0))
+ (end (set-marker (make-marker) (1+ (match-end 0)))))
+ (gnus-article-add-button start (1- end) 'gnus-signature-toggle
+ end)))))))
+
+(defun gnus-button-in-region-p (b e prop)
+ "Say whether PROP exists in the region."
+ (text-property-not-all b e prop nil))
+
+(defun gnus-article-add-buttons (&optional force)
+ "Find external references in the article and make buttons of them.
+\"External references\" are things like Message-IDs and URLs, as
+specified by `gnus-button-alist'."
+ (interactive (list 'force))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (case-fold-search t)
+ (alist gnus-button-alist)
+ beg entry regexp)
+ ;; Remove all old markers.
+ (let (marker entry)
+ (while (setq marker (pop gnus-button-marker-list))
+ (goto-char marker)
+ (when (setq entry (gnus-button-entry))
+ (put-text-property (match-beginning (nth 1 entry))
+ (match-end (nth 1 entry))
+ 'gnus-callback nil))
+ (set-marker marker nil)))
+ ;; We skip the headers.
+ (goto-char (point-min))
+ (unless (search-forward "\n\n" nil t)
+ (goto-char (point-max)))
+ (setq beg (point))
+ (while (setq entry (pop alist))
+ (setq regexp (car entry))
+ (goto-char beg)
+ (while (re-search-forward regexp nil t)
+ (let* ((start (and entry (match-beginning (nth 1 entry))))
+ (end (and entry (match-end (nth 1 entry))))
+ (from (match-beginning 0)))
+ (when (and (or (eq t (nth 2 entry))
+ (eval (nth 2 entry)))
+ (not (gnus-button-in-region-p
+ start end 'gnus-callback)))
+ ;; That optional form returned non-nil, so we add the
+ ;; button.
+ (gnus-article-add-button
+ start end 'gnus-button-push
+ (car (push (set-marker (make-marker) from)
+ gnus-button-marker-list))))))))))
+
+;; Add buttons to the head of an article.
+(defun gnus-article-add-buttons-to-head ()
+ "Add buttons to the head of the article."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (case-fold-search t)
+ (alist gnus-header-button-alist)
+ entry beg end)
+ (nnheader-narrow-to-headers)
+ (while alist
+ ;; Each alist entry.
+ (setq entry (car alist)
+ alist (cdr alist))
+ (goto-char (point-min))
+ (while (re-search-forward (car entry) nil t)
+ ;; Each header matching the entry.
+ (setq beg (match-beginning 0))
+ (setq end (or (and (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0))
+ (point-max)))
+ (goto-char beg)
+ (while (re-search-forward (nth 1 entry) end t)
+ ;; Each match within a header.
+ (let* ((entry (cdr entry))
+ (start (match-beginning (nth 1 entry)))
+ (end (match-end (nth 1 entry)))
+ (form (nth 2 entry)))
+ (goto-char (match-end 0))
+ (when (eval form)
+ (gnus-article-add-button
+ start end (nth 3 entry)
+ (buffer-substring (match-beginning (nth 4 entry))
+ (match-end (nth 4 entry)))))))
+ (goto-char end))))
+ (widen)))
+
+;;; External functions:
+
+(defun gnus-article-add-button (from to fun &optional data)
+ "Create a button between FROM and TO with callback FUN and data DATA."
+ (when gnus-article-button-face
+ (gnus-overlay-put (gnus-make-overlay from to)
+ 'face gnus-article-button-face))
+ (gnus-add-text-properties
+ from to
+ (nconc (and gnus-article-mouse-face
+ (list gnus-mouse-face-prop gnus-article-mouse-face))
+ (list 'gnus-callback fun)
+ (and data (list 'gnus-data data)))))
+
+;;; Internal functions:
+
+(defun gnus-article-set-globals ()
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-set-global-variables)))
+
+(defun gnus-signature-toggle (end)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t))
+ (if (get-text-property end 'invisible)
+ (gnus-article-unhide-text end (point-max))
+ (gnus-article-hide-text end (point-max) gnus-hidden-properties)))))
+
+(defun gnus-button-entry ()
+ ;; Return the first entry in `gnus-button-alist' matching this place.
+ (let ((alist gnus-button-alist)
+ (entry nil))
+ (while alist
+ (setq entry (pop alist))
+ (if (looking-at (car entry))
+ (setq alist nil)
+ (setq entry nil)))
+ entry))
+
+(defun gnus-button-push (marker)
+ ;; Push button starting at MARKER.
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char marker)
+ (let* ((entry (gnus-button-entry))
+ (inhibit-point-motion-hooks t)
+ (fun (nth 3 entry))
+ (args (mapcar (lambda (group)
+ (let ((string (match-string group)))
+ (gnus-set-text-properties
+ 0 (length string) nil string)
+ string))
+ (nthcdr 4 entry))))
+ (cond
+ ((fboundp fun)
+ (apply fun args))
+ ((and (boundp fun)
+ (fboundp (symbol-value fun)))
+ (apply (symbol-value fun) args))
+ (t
+ (gnus-message 1 "You must define `%S' to use this button"
+ (cons fun args)))))))
+
+(defun gnus-button-message-id (message-id)
+ "Fetch MESSAGE-ID."
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-refer-article message-id)))
+
+(defun gnus-button-fetch-group (address)
+ "Fetch GROUP specified by ADDRESS."
+ (if (not (string-match "[:/]" address))
+ ;; This is just a simple group url.
+ (gnus-group-read-ephemeral-group address gnus-select-method)
+ (if (not (string-match "^\\([^:/]+\\)\\(:\\([^/]+\\)/\\)?\\(.*\\)$"
+ address))
+ (error "Can't parse %s" address)
+ (gnus-group-read-ephemeral-group
+ (match-string 4 address)
+ `(nntp ,(match-string 1 address)
+ (nntp-address ,(match-string 1 address))
+ (nntp-port-number ,(if (match-end 3)
+ (match-string 3 address)
+ "nntp")))))))
+
+(defun gnus-split-string (string pattern)
+ "Return a list of substrings of STRING which are separated by PATTERN."
+ (let (parts (start 0))
+ (while (string-match pattern string start)
+ (setq parts (cons (substring string start (match-beginning 0)) parts)
+ start (match-end 0)))
+ (nreverse (cons (substring string start) parts))))
+
+(defun gnus-url-parse-query-string (query &optional downcase)
+ (let (retval pairs cur key val)
+ (setq pairs (gnus-split-string query "&"))
+ (while pairs
+ (setq cur (car pairs)
+ pairs (cdr pairs))
+ (if (not (string-match "=" cur))
+ nil ; Grace
+ (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
+ val (gnus-url-unhex-string (substring cur (match-end 0) nil)))
+ (if downcase
+ (setq key (downcase key)))
+ (setq cur (assoc key retval))
+ (if cur
+ (setcdr cur (cons val (cdr cur)))
+ (setq retval (cons (list key val) retval)))))
+ retval))
+
+(defun gnus-url-unhex (x)
+ (if (> x ?9)
+ (if (>= x ?a)
+ (+ 10 (- x ?a))
+ (+ 10 (- x ?A)))
+ (- x ?0)))
+
+(defun gnus-url-unhex-string (str &optional allow-newlines)
+ "Remove %XXX embedded spaces, etc in a url.
+If optional second argument ALLOW-NEWLINES is non-nil, then allow the
+decoding of carriage returns and line feeds in the string, which is normally
+forbidden in URL encoding."
+ (setq str (or str ""))
+ (let ((tmp "")
+ (case-fold-search t))
+ (while (string-match "%[0-9a-f][0-9a-f]" str)
+ (let* ((start (match-beginning 0))
+ (ch1 (gnus-url-unhex (elt str (+ start 1))))
+ (code (+ (* 16 ch1)
+ (gnus-url-unhex (elt str (+ start 2))))))
+ (setq tmp (concat
+ tmp (substring str 0 start)
+ (cond
+ (allow-newlines
+ (char-to-string code))
+ ((or (= code ?\n) (= code ?\r))
+ " ")
+ (t (char-to-string code))))
+ str (substring str (match-end 0)))))
+ (setq tmp (concat tmp str))
+ tmp))
+
+(defun gnus-url-mailto (url)
+ ;; Send mail to someone
+ (when (string-match "mailto:/*\\(.*\\)" url)
+ (setq url (substring url (match-beginning 1) nil)))
+ (let (to args source-url subject func)
+ (if (string-match (regexp-quote "?") url)
+ (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0)))
+ args (gnus-url-parse-query-string
+ (substring url (match-end 0) nil) t))
+ (setq to (gnus-url-unhex-string url)))
+ (setq args (cons (list "to" to) args)
+ subject (cdr-safe (assoc "subject" args)))
+ (message-mail)
+ (while args
+ (setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
+ (if (fboundp func)
+ (funcall func)
+ (message-position-on-field (caar args)))
+ (insert (mapconcat 'identity (cdar args) ", "))
+ (setq args (cdr args)))
+ (if subject
+ (message-goto-body)
+ (message-goto-subject))))
+
+(defun gnus-button-mailto (address)
+ ;; Mail to ADDRESS.
+ (set-buffer (gnus-copy-article-buffer))
+ (message-reply address))
+
+(defun gnus-button-reply (address)
+ ;; Reply to ADDRESS.
+ (message-reply address))
+
+(defun gnus-button-url (address)
+ "Browse ADDRESS."
+ (funcall browse-url-browser-function address))
+
+(defun gnus-button-embedded-url (address)
+ "Browse ADDRESS."
+ (funcall browse-url-browser-function (gnus-strip-whitespace address)))
+
+;;; Next/prev buttons in the article buffer.
+
+(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
+(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
+
+(defvar gnus-prev-page-map nil)
+(unless gnus-prev-page-map
+ (setq gnus-prev-page-map (make-sparse-keymap))
+ (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page)
+ (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
+
+(defun gnus-insert-prev-page-button ()
+ (let ((buffer-read-only nil))
+ (gnus-eval-format
+ gnus-prev-page-line-format nil
+ `(gnus-prev t local-map ,gnus-prev-page-map
+ gnus-callback gnus-article-button-prev-page))))
+
+(defvar gnus-next-page-map nil)
+(unless gnus-next-page-map
+ (setq gnus-next-page-map (make-keymap))
+ (suppress-keymap gnus-prev-page-map)
+ (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page)
+ (define-key gnus-next-page-map "\r" 'gnus-button-next-page))
+
+(defun gnus-button-next-page ()
+ "Go to the next page."
+ (interactive)
+ (let ((win (selected-window)))
+ (select-window (get-buffer-window gnus-article-buffer t))
+ (gnus-article-next-page)
+ (select-window win)))
+
+(defun gnus-button-prev-page ()
+ "Go to the prev page."
+ (interactive)
+ (let ((win (selected-window)))
+ (select-window (get-buffer-window gnus-article-buffer t))
+ (gnus-article-prev-page)
+ (select-window win)))
+
+(defun gnus-insert-next-page-button ()
+ (let ((buffer-read-only nil))
+ (gnus-eval-format gnus-next-page-line-format nil
+ `(gnus-next t local-map ,gnus-next-page-map
+ gnus-callback
+ gnus-article-button-next-page))))
+
+(defun gnus-article-button-next-page (arg)
+ "Go to the next page."
+ (interactive "P")
+ (let ((win (selected-window)))
+ (select-window (get-buffer-window gnus-article-buffer t))
+ (gnus-article-next-page)
+ (select-window win)))
+
+(defun gnus-article-button-prev-page (arg)
+ "Go to the prev page."
+ (interactive "P")
+ (let ((win (selected-window)))
+ (select-window (get-buffer-window gnus-article-buffer t))
+ (gnus-article-prev-page)
+ (select-window win)))
+
+(gnus-ems-redefine)
+
+(provide 'gnus-art)
+
+(run-hooks 'gnus-art-load-hook)
+
+;;; gnus-art.el ends here
--- /dev/null
+;;; gnus-async.el --- asynchronous support for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-sum)
+(require 'nntp)
+
+(defgroup gnus-asynchronous nil
+ "Support for asynchronous operations."
+ :group 'gnus)
+
+(defcustom gnus-asynchronous t
+ "*If nil, inhibit all Gnus asynchronicity.
+If non-nil, let the other asynch variables be heeded."
+ :group 'gnus-asynchronous
+ :type 'boolean)
+
+(defcustom gnus-use-article-prefetch 30
+ "*If non-nil, prefetch articles in groups that allow this.
+If a number, prefetch only that many articles forward;
+if t, prefetch as many articles as possible."
+ :group 'gnus-asynchronous
+ :type '(choice (const :tag "off" nil)
+ (const :tag "all" t)
+ (integer :tag "some" 0)))
+
+(defcustom gnus-prefetched-article-deletion-strategy '(read exit)
+ "List of symbols that say when to remove articles from the prefetch buffer.
+Possible values in this list are `read', which means that
+articles are removed as they are read, and `exit', which means
+that all articles belonging to a group are removed on exit
+from that group."
+ :group 'gnus-asynchronous
+ :type '(set (const read) (const exit)))
+
+(defcustom gnus-use-header-prefetch nil
+ "*If non-nil, prefetch the headers to the next group."
+ :group 'gnus-asynchronous
+ :type 'boolean)
+
+(defcustom gnus-async-prefetch-article-p 'gnus-async-unread-p
+ "Function called to say whether an article should be prefetched or not.
+The function is called with one parameter -- the article data.
+It should return non-nil if the article is to be prefetched."
+ :group 'gnus-asynchronous
+ :type 'function)
+
+;;; Internal variables.
+
+(defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*")
+(defvar gnus-async-article-alist nil)
+(defvar gnus-async-article-semaphore '(nil))
+(defvar gnus-async-fetch-list nil)
+
+(defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*")
+(defvar gnus-async-header-prefetched nil)
+
+;;; Utility functions.
+
+(defun gnus-group-asynchronous-p (group)
+ "Say whether GROUP is fetched from a server that supports asynchronicity."
+ (gnus-asynchronous-p (gnus-find-method-for-group group)))
+
+;;; Somewhat bogus semaphores.
+
+(defun gnus-async-get-semaphore (semaphore)
+ "Wait until SEMAPHORE is released."
+ (while (/= (length (nconc (symbol-value semaphore) (list nil))) 2)
+ (sleep-for 1)))
+
+(defun gnus-async-release-semaphore (semaphore)
+ "Release SEMAPHORE."
+ (setcdr (symbol-value semaphore) nil))
+
+(defmacro gnus-async-with-semaphore (&rest forms)
+ `(unwind-protect
+ (progn
+ (gnus-async-get-semaphore 'gnus-async-article-semaphore)
+ ,@forms)
+ (gnus-async-release-semaphore 'gnus-async-article-semaphore)))
+
+(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0)
+(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body))
+
+;;;
+;;; Article prefetch
+;;;
+
+(gnus-add-shutdown 'gnus-async-close 'gnus)
+(defun gnus-async-close ()
+ (gnus-kill-buffer gnus-async-prefetch-article-buffer)
+ (gnus-kill-buffer gnus-async-prefetch-headers-buffer)
+ (setq gnus-async-article-alist nil
+ gnus-async-header-prefetched nil))
+
+(defun gnus-async-set-buffer ()
+ (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t))
+
+(defun gnus-async-halt-prefetch ()
+ "Stop prefetching."
+ (setq gnus-async-fetch-list nil))
+
+(defun gnus-async-prefetch-next (group article summary)
+ "Possibly prefetch several articles starting with the article after ARTICLE."
+ (when (and (gnus-buffer-live-p summary)
+ gnus-asynchronous
+ (gnus-group-asynchronous-p group))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let ((next (caadr (gnus-data-find-list article))))
+ (when next
+ (if (not (fboundp 'run-with-idle-timer))
+ ;; This is either an older Emacs or XEmacs, so we
+ ;; do this, which leads to slightly slower article
+ ;; buffer display.
+ (gnus-async-prefetch-article group next summary)
+ (run-with-idle-timer
+ 0.1 nil 'gnus-async-prefetch-article group next summary)))))))
+
+(defun gnus-async-prefetch-article (group article summary &optional next)
+ "Possibly prefetch several articles starting with ARTICLE."
+ (if (not (gnus-buffer-live-p summary))
+ (gnus-async-with-semaphore
+ (setq gnus-async-fetch-list nil))
+ (when (and gnus-asynchronous
+ (gnus-alive-p))
+ (when next
+ (gnus-async-with-semaphore
+ (pop gnus-async-fetch-list)))
+ (let ((do-fetch next)
+ (do-message t)) ;(eq major-mode 'gnus-summary-mode)))
+ (when (and (gnus-group-asynchronous-p group)
+ (gnus-buffer-live-p summary)
+ (or (not next)
+ gnus-async-fetch-list))
+ (gnus-async-with-semaphore
+ (unless next
+ (setq do-fetch (not gnus-async-fetch-list))
+ ;; Nix out any outstanding requests.
+ (setq gnus-async-fetch-list nil)
+ ;; Fill in the new list.
+ (let ((n gnus-use-article-prefetch)
+ (data (gnus-data-find-list article))
+ d)
+ (while (and (setq d (pop data))
+ (if (numberp n)
+ (natnump (decf n))
+ n))
+ (unless (or (gnus-async-prefetched-article-entry
+ group (setq article (gnus-data-number d)))
+ (not (natnump article))
+ (not (funcall gnus-async-prefetch-article-p d)))
+ ;; Not already fetched -- so we add it to the list.
+ (push article gnus-async-fetch-list)))
+ (setq gnus-async-fetch-list
+ (nreverse gnus-async-fetch-list))))
+
+ (when do-fetch
+ (setq article (car gnus-async-fetch-list))))
+
+ (when (and do-fetch article)
+ ;; We want to fetch some more articles.
+ (save-excursion
+ (set-buffer summary)
+ (let (mark)
+ (gnus-async-set-buffer)
+ (goto-char (point-max))
+ (setq mark (point-marker))
+ (let ((nnheader-callback-function
+ (gnus-make-async-article-function
+ group article mark summary next))
+ (nntp-server-buffer
+ (get-buffer gnus-async-prefetch-article-buffer)))
+ (when do-message
+ (gnus-message 9 "Prefetching article %d in group %s"
+ article group))
+ (gnus-request-article article group))))))))))
+
+(defun gnus-make-async-article-function (group article mark summary next)
+ "Return a callback function."
+ `(lambda (arg)
+ (save-excursion
+ (when arg
+ (gnus-async-set-buffer)
+ (gnus-async-with-semaphore
+ (push (list ',(intern (format "%s-%d" group article))
+ ,mark (set-marker (make-marker) (point-max))
+ ,group ,article)
+ gnus-async-article-alist)))
+ (if (not (gnus-buffer-live-p ,summary))
+ (gnus-async-with-semaphore
+ (setq gnus-async-fetch-list nil))
+ (gnus-async-prefetch-article ,group ,next ,summary t)))))
+
+(defun gnus-async-unread-p (data)
+ "Return non-nil if DATA represents an unread article."
+ (gnus-data-unread-p data))
+
+(defun gnus-async-request-fetched-article (group article buffer)
+ "See whether we have ARTICLE from GROUP and put it in BUFFER."
+ (when (numberp article)
+ (let ((entry (gnus-async-prefetched-article-entry group article)))
+ (when entry
+ (save-excursion
+ (gnus-async-set-buffer)
+ (copy-to-buffer buffer (cadr entry) (caddr entry))
+ ;; Remove the read article from the prefetch buffer.
+ (when (memq 'read gnus-prefetched-article-deletion-strategy)
+ (gnus-async-delete-prefected-entry entry))
+ t)))))
+
+(defun gnus-async-delete-prefected-entry (entry)
+ "Delete ENTRY from buffer and alist."
+ (ignore-errors
+ (delete-region (cadr entry) (caddr entry))
+ (set-marker (cadr entry) nil)
+ (set-marker (caddr entry) nil))
+ (gnus-async-with-semaphore
+ (setq gnus-async-article-alist
+ (delq entry gnus-async-article-alist))))
+
+(defun gnus-async-prefetch-remove-group (group)
+ "Remove all articles belonging to GROUP from the prefetch buffer."
+ (when (and (gnus-group-asynchronous-p group)
+ (memq 'exit gnus-prefetched-article-deletion-strategy))
+ (let ((alist gnus-async-article-alist))
+ (save-excursion
+ (gnus-async-set-buffer)
+ (while alist
+ (when (equal group (nth 3 (car alist)))
+ (gnus-async-delete-prefected-entry (car alist)))
+ (pop alist))))))
+
+(defun gnus-async-prefetched-article-entry (group article)
+ "Return the entry for ARTICLE in GROUP iff it has been prefetched."
+ (let ((entry (assq (intern (format "%s-%d" group article))
+ gnus-async-article-alist)))
+ ;; Perhaps something has emptied the buffer?
+ (if (and entry
+ (= (cadr entry) (caddr entry)))
+ (progn
+ (ignore-errors
+ (set-marker (cadr entry) nil)
+ (set-marker (caddr entry) nil))
+ (setq gnus-async-article-alist
+ (delq entry gnus-async-article-alist))
+ nil)
+ entry)))
+
+;;;
+;;; Header prefetch
+;;;
+
+(defun gnus-async-prefetch-headers (group)
+ "Prefetch the headers for group GROUP."
+ (save-excursion
+ (let (unread)
+ (when (and gnus-use-header-prefetch
+ gnus-asynchronous
+ (gnus-group-asynchronous-p group)
+ (listp gnus-async-header-prefetched)
+ (setq unread (gnus-list-of-unread-articles group)))
+ ;; Mark that a fetch is in progress.
+ (setq gnus-async-header-prefetched t)
+ (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t)
+ (erase-buffer)
+ (let ((nntp-server-buffer (current-buffer))
+ (nnheader-callback-function
+ `(lambda (arg)
+ (setq gnus-async-header-prefetched
+ ,(cons group unread)))))
+ (gnus-retrieve-headers unread group gnus-fetch-old-headers))))))
+
+(defun gnus-async-retrieve-fetched-headers (articles group)
+ "See whether we have prefetched headers."
+ (when (and gnus-use-header-prefetch
+ (gnus-group-asynchronous-p group)
+ (listp gnus-async-header-prefetched)
+ (equal group (car gnus-async-header-prefetched))
+ (equal articles (cdr gnus-async-header-prefetched)))
+ (save-excursion
+ (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t)
+ (nntp-decode-text)
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ (erase-buffer)
+ (setq gnus-async-header-prefetched nil)
+ t)))
+
+(provide 'gnus-async)
+
+;;; gnus-async.el ends here
--- /dev/null
+;;; gnus-audio.el --- Sound effects for Gnus
+;; Copyright (C) 1996 Free Software Foundation
+
+;; Author: Steven L. Baur <steve@miranova.com>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;; This file provides access to sound effects in Gnus.
+;; Prerelease: This file is partially stripped to support earcons.el
+;; You can safely ignore most of it until Red Gnus. **Evil Laugh**
+;;; Code:
+
+(when (null (boundp 'running-xemacs))
+ (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)))
+
+(require 'nnheader)
+(eval-when-compile (require 'cl))
+
+(defvar gnus-audio-inline-sound
+ (and (fboundp 'device-sound-enabled-p)
+ (device-sound-enabled-p))
+ "When t, we will not spawn a subprocess to play sounds.")
+
+(defvar gnus-audio-directory (nnheader-find-etc-directory "sounds")
+ "The directory containing the Sound Files.")
+
+(defvar gnus-audio-au-player "/usr/bin/showaudio"
+ "Executable program for playing sun AU format sound files")
+(defvar gnus-audio-wav-player "/usr/local/bin/play"
+ "Executable program for playing WAV files")
+
+
+;;; The following isn't implemented yet. Wait for Red Gnus.
+;(defvar gnus-audio-effects-enabled t
+; "When t, Gnus will use sound effects.")
+;(defvar gnus-audio-enable-hooks nil
+; "Functions run when enabling sound effects.")
+;(defvar gnus-audio-disable-hooks nil
+; "Functions run when disabling sound effects.")
+;(defvar gnus-audio-theme-song nil
+; "Theme song for Gnus.")
+;(defvar gnus-audio-enter-group nil
+; "Sound effect played when selecting a group.")
+;(defvar gnus-audio-exit-group nil
+; "Sound effect played when exiting a group.")
+;(defvar gnus-audio-score-group nil
+; "Sound effect played when scoring a group.")
+;(defvar gnus-audio-busy-sound nil
+; "Sound effect played when going into a ... sequence.")
+
+
+;;;###autoload
+ ;(defun gnus-audio-enable-sound ()
+; "Enable Sound Effects for Gnus."
+; (interactive)
+; (setq gnus-audio-effects-enabled t)
+; (run-hooks gnus-audio-enable-hooks))
+
+;;;###autoload
+ ;(defun gnus-audio-disable-sound ()
+; "Disable Sound Effects for Gnus."
+; (interactive)
+; (setq gnus-audio-effects-enabled nil)
+; (run-hooks gnus-audio-disable-hooks))
+
+;;;###autoload
+(defun gnus-audio-play (file)
+ "Play a sound through the speaker."
+ (interactive)
+ (let ((sound-file (if (file-exists-p file)
+ file
+ (concat gnus-audio-directory file))))
+ (when (file-exists-p sound-file)
+ (if gnus-audio-inline-sound
+ (play-sound-file sound-file)
+ (cond ((string-match "\\.wav$" sound-file)
+ (call-process gnus-audio-wav-player
+ sound-file
+ 0
+ nil
+ sound-file))
+ ((string-match "\\.au$" sound-file)
+ (call-process gnus-audio-au-player
+ sound-file
+ 0
+ nil
+ sound-file)))))))
+
+
+;;; The following isn't implemented yet, wait for Red Gnus
+ ;(defun gnus-audio-startrek-sounds ()
+; "Enable sounds from Star Trek the original series."
+; (interactive)
+; (setq gnus-audio-busy-sound "working.au")
+; (setq gnus-audio-enter-group "bulkhead_door.au")
+; (setq gnus-audio-exit-group "bulkhead_door.au")
+; (setq gnus-audio-score-group "ST_laser.au")
+; (setq gnus-audio-theme-song "startrek.au")
+; (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group)
+; (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group))
+;;;***
+
+(defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au"
+ "Name of the Gnus startup jingle file.")
+
+(defun gnus-play-jingle ()
+ "Play the Gnus startup jingle, unless that's inhibited."
+ (interactive)
+ (gnus-audio-play gnus-startup-jingle))
+
+(provide 'gnus-audio)
+
+(run-hooks 'gnus-audio-load-hook)
+
+;;; gnus-audio.el ends here
--- /dev/null
+;;; gnus-bcklg.el --- backlog functions for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+
+;;;
+;;; Buffering of read articles.
+;;;
+
+(defvar gnus-backlog-buffer " *Gnus Backlog*")
+(defvar gnus-backlog-articles nil)
+(defvar gnus-backlog-hashtb nil)
+
+(defun gnus-backlog-buffer ()
+ "Return the backlog buffer."
+ (or (get-buffer gnus-backlog-buffer)
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-backlog-buffer))
+ (buffer-disable-undo (current-buffer))
+ (setq buffer-read-only t)
+ (gnus-add-current-to-buffer-list)
+ (get-buffer gnus-backlog-buffer))))
+
+(defun gnus-backlog-setup ()
+ "Initialize backlog variables."
+ (unless gnus-backlog-hashtb
+ (setq gnus-backlog-hashtb (gnus-make-hashtable 1024))))
+
+(gnus-add-shutdown 'gnus-backlog-shutdown 'gnus)
+
+(defun gnus-backlog-shutdown ()
+ "Clear all backlog variables and buffers."
+ (when (get-buffer gnus-backlog-buffer)
+ (kill-buffer gnus-backlog-buffer))
+ (setq gnus-backlog-hashtb nil
+ gnus-backlog-articles nil))
+
+(defun gnus-backlog-enter-article (group number buffer)
+ (gnus-backlog-setup)
+ (let ((ident (intern (concat group ":" (int-to-string number))
+ gnus-backlog-hashtb))
+ b)
+ (if (memq ident gnus-backlog-articles)
+ () ; It's already kept.
+ ;; Remove the oldest article, if necessary.
+ (and (numberp gnus-keep-backlog)
+ (>= (length gnus-backlog-articles) gnus-keep-backlog)
+ (gnus-backlog-remove-oldest-article))
+ (push ident gnus-backlog-articles)
+ ;; Insert the new article.
+ (save-excursion
+ (set-buffer (gnus-backlog-buffer))
+ (let (buffer-read-only)
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (setq b (point))
+ (insert-buffer-substring buffer)
+ ;; Tag the beginning of the article with the ident.
+ (gnus-put-text-property b (1+ b) 'gnus-backlog ident))))))
+
+(defun gnus-backlog-remove-oldest-article ()
+ (save-excursion
+ (set-buffer (gnus-backlog-buffer))
+ (goto-char (point-min))
+ (if (zerop (buffer-size))
+ () ; The buffer is empty.
+ (let ((ident (get-text-property (point) 'gnus-backlog))
+ buffer-read-only)
+ ;; Remove the ident from the list of articles.
+ (when ident
+ (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
+ ;; Delete the article itself.
+ (delete-region
+ (point) (next-single-property-change
+ (1+ (point)) 'gnus-backlog nil (point-max)))))))
+
+(defun gnus-backlog-remove-article (group number)
+ "Remove article NUMBER in GROUP from the backlog."
+ (when (numberp number)
+ (gnus-backlog-setup)
+ (let ((ident (intern (concat group ":" (int-to-string number))
+ gnus-backlog-hashtb))
+ beg end)
+ (when (memq ident gnus-backlog-articles)
+ ;; It was in the backlog.
+ (save-excursion
+ (set-buffer (gnus-backlog-buffer))
+ (let (buffer-read-only)
+ (when (setq beg (text-property-any
+ (point-min) (point-max) 'gnus-backlog
+ ident))
+ ;; Find the end (i. e., the beginning of the next article).
+ (setq end
+ (next-single-property-change
+ (1+ beg) 'gnus-backlog (current-buffer) (point-max)))
+ (delete-region beg end)
+ ;; Return success.
+ t))
+ (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))))))
+
+(defun gnus-backlog-request-article (group number buffer)
+ (when (numberp number)
+ (gnus-backlog-setup)
+ (let ((ident (intern (concat group ":" (int-to-string number))
+ gnus-backlog-hashtb))
+ beg end)
+ (when (memq ident gnus-backlog-articles)
+ ;; It was in the backlog.
+ (save-excursion
+ (set-buffer (gnus-backlog-buffer))
+ (if (not (setq beg (text-property-any
+ (point-min) (point-max) 'gnus-backlog
+ ident)))
+ ;; It wasn't in the backlog after all.
+ (ignore
+ (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
+ ;; Find the end (i. e., the beginning of the next article).
+ (setq end
+ (next-single-property-change
+ (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (insert-buffer-substring gnus-backlog-buffer beg end)
+ t)))))
+
+(provide 'gnus-bcklg)
+
+;;; gnus-bcklg.el ends here
--- /dev/null
+;;; gnus-cache.el --- cache interface for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-int)
+(require 'gnus-range)
+(require 'gnus-start)
+(eval-when-compile
+ (require 'gnus-sum))
+
+(defgroup gnus-cache nil
+ "Cache interface."
+ :group 'gnus)
+
+(defcustom gnus-cache-directory
+ (nnheader-concat gnus-directory "cache/")
+ "*The directory where cached articles will be stored."
+ :group 'gnus-cache
+ :type 'directory)
+
+(defcustom gnus-cache-active-file
+ (concat (file-name-as-directory gnus-cache-directory) "active")
+ "*The cache active file."
+ :group 'gnus-cache
+ :type 'file)
+
+(defcustom gnus-cache-enter-articles '(ticked dormant)
+ "Classes of articles to enter into the cache."
+ :group 'gnus-cache
+ :type '(set (const ticked) (const dormant) (const unread) (const read)))
+
+(defcustom gnus-cache-remove-articles '(read)
+ "Classes of articles to remove from the cache."
+ :group 'gnus-cache
+ :type '(set (const ticked) (const dormant) (const unread) (const read)))
+
+(defcustom gnus-uncacheable-groups nil
+ "*Groups that match this regexp will not be cached.
+
+If you want to avoid caching your nnml groups, you could set this
+variable to \"^nnml\"."
+ :group 'gnus-cache
+ :type '(choice (const :tag "off" nil)
+ regexp))
+
+\f
+
+;;; Internal variables.
+
+(defvar gnus-cache-removable-articles nil)
+(defvar gnus-cache-buffer nil)
+(defvar gnus-cache-active-hashtb nil)
+(defvar gnus-cache-active-altered nil)
+
+(eval-and-compile
+ (autoload 'nnml-generate-nov-databases-1 "nnml")
+ (autoload 'nnvirtual-find-group-art "nnvirtual"))
+
+\f
+
+;;; Functions called from Gnus.
+
+(defun gnus-cache-open ()
+ "Initialize the cache."
+ (when (or (file-exists-p gnus-cache-directory)
+ (and gnus-use-cache
+ (not (eq gnus-use-cache 'passive))))
+ (gnus-cache-read-active)))
+
+;; Complexities of byte-compiling make this kludge necessary. Eeek.
+(ignore-errors
+ (gnus-add-shutdown 'gnus-cache-close 'gnus))
+
+(defun gnus-cache-close ()
+ "Shut down the cache."
+ (gnus-cache-write-active)
+ (gnus-cache-save-buffers)
+ (setq gnus-cache-active-hashtb nil))
+
+(defun gnus-cache-save-buffers ()
+ ;; save the overview buffer if it exists and has been modified
+ ;; delete empty cache subdirectories
+ (when gnus-cache-buffer
+ (let ((buffer (cdr gnus-cache-buffer))
+ (overview-file (gnus-cache-file-name
+ (car gnus-cache-buffer) ".overview")))
+ ;; write the overview only if it was modified
+ (when (buffer-modified-p buffer)
+ (save-excursion
+ (set-buffer buffer)
+ (if (> (buffer-size) 0)
+ ;; Non-empty overview, write it to a file.
+ (gnus-write-buffer overview-file)
+ ;; Empty overview file, remove it
+ (when (file-exists-p overview-file)
+ (delete-file overview-file))
+ ;; If possible, remove group's cache subdirectory.
+ (condition-case nil
+ ;; FIXME: we can detect the error type and warn the user
+ ;; of any inconsistencies (articles w/o nov entries?).
+ ;; for now, just be conservative...delete only if safe -- sj
+ (delete-directory (file-name-directory overview-file))
+ (error nil)))))
+ ;; Kill the buffer -- it's either unmodified or saved.
+ (gnus-kill-buffer buffer)
+ (setq gnus-cache-buffer nil))))
+
+(defun gnus-cache-possibly-enter-article
+ (group article headers ticked dormant unread &optional force)
+ (when (and (or force (not (eq gnus-use-cache 'passive)))
+ (numberp article)
+ (> article 0)
+ (vectorp headers)) ; This might be a dummy article.
+ ;; If this is a virtual group, we find the real group.
+ (when (gnus-virtual-group-p group)
+ (let ((result (nnvirtual-find-group-art
+ (gnus-group-real-name group) article)))
+ (setq group (car result)
+ headers (copy-sequence headers))
+ (mail-header-set-number headers (cdr result))))
+ (let ((number (mail-header-number headers))
+ file dir)
+ (when (and number
+ (> number 0) ; Reffed article.
+ (or force
+ (and (or (not gnus-uncacheable-groups)
+ (not (string-match
+ gnus-uncacheable-groups group)))
+ (gnus-cache-member-of-class
+ gnus-cache-enter-articles ticked dormant unread)))
+ (not (file-exists-p (setq file (gnus-cache-file-name
+ group number)))))
+ ;; Possibly create the cache directory.
+ (gnus-make-directory (setq dir (file-name-directory file)))
+ ;; Save the article in the cache.
+ (if (file-exists-p file)
+ t ; The article already is saved.
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let ((gnus-use-cache nil))
+ (gnus-request-article-this-buffer number group))
+ (when (> (buffer-size) 0)
+ (gnus-write-buffer file)
+ (gnus-cache-change-buffer group)
+ (set-buffer (cdr gnus-cache-buffer))
+ (goto-char (point-max))
+ (forward-line -1)
+ (while (condition-case ()
+ (when (not (bobp))
+ (> (read (current-buffer)) number))
+ (error
+ ;; The line was malformed, so we just remove it!!
+ (gnus-delete-line)
+ t))
+ (forward-line -1))
+ (if (bobp)
+ (if (not (eobp))
+ (progn
+ (beginning-of-line)
+ (when (< (read (current-buffer)) number)
+ (forward-line 1)))
+ (beginning-of-line))
+ (forward-line 1))
+ (beginning-of-line)
+ ;; [number subject from date id references chars lines xref]
+ (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n"
+ (mail-header-number headers)
+ (mail-header-subject headers)
+ (mail-header-from headers)
+ (mail-header-date headers)
+ (mail-header-id headers)
+ (or (mail-header-references headers) "")
+ (or (mail-header-chars headers) "")
+ (or (mail-header-lines headers) "")
+ (or (mail-header-xref headers) "")))
+ ;; Update the active info.
+ (set-buffer gnus-summary-buffer)
+ (gnus-cache-update-active group number)
+ (push article gnus-newsgroup-cached)
+ (gnus-summary-update-secondary-mark article))
+ t))))))
+
+(defun gnus-cache-enter-remove-article (article)
+ "Mark ARTICLE for later possible removal."
+ (when article
+ (push article gnus-cache-removable-articles)))
+
+(defun gnus-cache-possibly-remove-articles ()
+ "Possibly remove some of the removable articles."
+ (if (not (gnus-virtual-group-p gnus-newsgroup-name))
+ (gnus-cache-possibly-remove-articles-1)
+ (let ((arts gnus-cache-removable-articles)
+ ga)
+ (while arts
+ (when (setq ga (nnvirtual-find-group-art
+ (gnus-group-real-name gnus-newsgroup-name) (pop arts)))
+ (let ((gnus-cache-removable-articles (list (cdr ga)))
+ (gnus-newsgroup-name (car ga)))
+ (gnus-cache-possibly-remove-articles-1)))))
+ (setq gnus-cache-removable-articles nil)))
+
+(defun gnus-cache-possibly-remove-articles-1 ()
+ "Possibly remove some of the removable articles."
+ (unless (eq gnus-use-cache 'passive)
+ (let ((articles gnus-cache-removable-articles)
+ (cache-articles gnus-newsgroup-cached)
+ article)
+ (gnus-cache-change-buffer gnus-newsgroup-name)
+ (while articles
+ (when (memq (setq article (pop articles)) cache-articles)
+ ;; The article was in the cache, so we see whether we are
+ ;; supposed to remove it from the cache.
+ (gnus-cache-possibly-remove-article
+ article (memq article gnus-newsgroup-marked)
+ (memq article gnus-newsgroup-dormant)
+ (or (memq article gnus-newsgroup-unreads)
+ (memq article gnus-newsgroup-unselected))))))
+ ;; The overview file might have been modified, save it
+ ;; safe because we're only called at group exit anyway.
+ (gnus-cache-save-buffers)))
+
+(defun gnus-cache-request-article (article group)
+ "Retrieve ARTICLE in GROUP from the cache."
+ (let ((file (gnus-cache-file-name group article))
+ (buffer-read-only nil))
+ (when (file-exists-p file)
+ (erase-buffer)
+ (gnus-kill-all-overlays)
+ (insert-file-contents file)
+ t)))
+
+(defun gnus-cache-possibly-alter-active (group active)
+ "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
+ (when gnus-cache-active-hashtb
+ (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
+ (when cache-active
+ (when (< (car cache-active) (car active))
+ (setcar active (car cache-active)))
+ (when (> (cdr cache-active) (cdr active))
+ (setcdr active (cdr cache-active)))))))
+
+(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
+ "Retrieve the headers for ARTICLES in GROUP."
+ (let ((cached
+ (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
+ (if (not cached)
+ ;; No cached articles here, so we just retrieve them
+ ;; the normal way.
+ (let ((gnus-use-cache nil))
+ (gnus-retrieve-headers articles group fetch-old))
+ (let ((uncached-articles (gnus-sorted-intersection
+ (gnus-sorted-complement articles cached)
+ articles))
+ (cache-file (gnus-cache-file-name group ".overview"))
+ type)
+ ;; We first retrieve all the headers that we don't have in
+ ;; the cache.
+ (let ((gnus-use-cache nil))
+ (when uncached-articles
+ (setq type (and articles
+ (gnus-retrieve-headers
+ uncached-articles group fetch-old)))))
+ (gnus-cache-save-buffers)
+ ;; Then we insert the cached headers.
+ (save-excursion
+ (cond
+ ((not (file-exists-p cache-file))
+ ;; There are no cached headers.
+ type)
+ ((null type)
+ ;; There were no uncached headers (or retrieval was
+ ;; unsuccessful), so we use the cached headers exclusively.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-file-contents cache-file)
+ 'nov)
+ ((eq type 'nov)
+ ;; We have both cached and uncached NOV headers, so we
+ ;; braid them.
+ (gnus-cache-braid-nov group cached)
+ type)
+ (t
+ ;; We braid HEADs.
+ (gnus-cache-braid-heads group (gnus-sorted-intersection
+ cached articles))
+ type)))))))
+
+(defun gnus-cache-enter-article (&optional n)
+ "Enter the next N articles into the cache.
+If not given a prefix, use the process marked articles instead.
+Returns the list of articles entered."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((articles (gnus-summary-work-articles n))
+ article out)
+ (while (setq article (pop articles))
+ (if (natnump article)
+ (when (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ nil nil nil t)
+ (push article out))
+ (gnus-message 2 "Can't cache article %d" article))
+ (gnus-summary-remove-process-mark article)
+ (gnus-summary-update-secondary-mark article))
+ (gnus-summary-next-subject 1)
+ (gnus-summary-position-point)
+ (nreverse out)))
+
+(defun gnus-cache-remove-article (n)
+ "Remove the next N articles from the cache.
+If not given a prefix, use the process marked articles instead.
+Returns the list of articles removed."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-cache-change-buffer gnus-newsgroup-name)
+ (let ((articles (gnus-summary-work-articles n))
+ article out)
+ (while articles
+ (setq article (pop articles))
+ (when (gnus-cache-possibly-remove-article article nil nil nil t)
+ (push article out))
+ (gnus-summary-remove-process-mark article)
+ (gnus-summary-update-secondary-mark article))
+ (gnus-summary-next-subject 1)
+ (gnus-summary-position-point)
+ (nreverse out)))
+
+(defun gnus-cached-article-p (article)
+ "Say whether ARTICLE is cached in the current group."
+ (memq article gnus-newsgroup-cached))
+
+(defun gnus-summary-insert-cached-articles ()
+ "Insert all the articles cached for this group into the current buffer."
+ (interactive)
+ (let ((cached gnus-newsgroup-cached)
+ (gnus-verbose (max 6 gnus-verbose)))
+ (unless cached
+ (error "No cached articles for this group"))
+ (while cached
+ (gnus-summary-goto-subject (pop cached) t))))
+
+;;; Internal functions.
+
+(defun gnus-cache-change-buffer (group)
+ (and gnus-cache-buffer
+ ;; See if the current group's overview cache has been loaded.
+ (or (string= group (car gnus-cache-buffer))
+ ;; Another overview cache is current, save it.
+ (gnus-cache-save-buffers)))
+ ;; if gnus-cache buffer is nil, create it
+ (unless gnus-cache-buffer
+ ;; Create cache buffer
+ (save-excursion
+ (setq gnus-cache-buffer
+ (cons group
+ (set-buffer (get-buffer-create " *gnus-cache-overview*"))))
+ (buffer-disable-undo (current-buffer))
+ ;; Insert the contents of this group's cache overview.
+ (erase-buffer)
+ (let ((file (gnus-cache-file-name group ".overview")))
+ (when (file-exists-p file)
+ (nnheader-insert-file-contents file)))
+ ;; We have a fresh (empty/just loaded) buffer,
+ ;; mark it as unmodified to save a redundant write later.
+ (set-buffer-modified-p nil))))
+
+;; Return whether an article is a member of a class.
+(defun gnus-cache-member-of-class (class ticked dormant unread)
+ (or (and ticked (memq 'ticked class))
+ (and dormant (memq 'dormant class))
+ (and unread (memq 'unread class))
+ (and (not unread) (not ticked) (not dormant) (memq 'read class))))
+
+(defun gnus-cache-file-name (group article)
+ (concat (file-name-as-directory gnus-cache-directory)
+ (file-name-as-directory
+ (nnheader-translate-file-chars
+ (if (gnus-use-long-file-name 'not-cache)
+ group
+ (let ((group (nnheader-replace-chars-in-string group ?/ ?_)))
+ ;; Translate the first colon into a slash.
+ (when (string-match ":" group)
+ (aset group (match-beginning 0) ?/))
+ (nnheader-replace-chars-in-string group ?. ?/)))))
+ (if (stringp article) article (int-to-string article))))
+
+(defun gnus-cache-update-article (group article)
+ "If ARTICLE is in the cache, remove it and re-enter it."
+ (when (gnus-cache-possibly-remove-article article nil nil nil t)
+ (let ((gnus-use-cache nil))
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article (gnus-summary-article-header article)
+ nil nil nil t))))
+
+(defun gnus-cache-possibly-remove-article (article ticked dormant unread
+ &optional force)
+ "Possibly remove ARTICLE from the cache."
+ (let ((group gnus-newsgroup-name)
+ (number article)
+ file)
+ ;; If this is a virtual group, we find the real group.
+ (when (gnus-virtual-group-p group)
+ (let ((result (nnvirtual-find-group-art
+ (gnus-group-real-name group) article)))
+ (setq group (car result)
+ number (cdr result))))
+ (setq file (gnus-cache-file-name group number))
+ (when (and (file-exists-p file)
+ (or force
+ (gnus-cache-member-of-class
+ gnus-cache-remove-articles ticked dormant unread)))
+ (save-excursion
+ (delete-file file)
+ (set-buffer (cdr gnus-cache-buffer))
+ (goto-char (point-min))
+ (when (or (looking-at (concat (int-to-string number) "\t"))
+ (search-forward (concat "\n" (int-to-string number) "\t")
+ (point-max) t))
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point)))))
+ (setq gnus-newsgroup-cached
+ (delq article gnus-newsgroup-cached))
+ (gnus-summary-update-secondary-mark article)
+ t)))
+
+(defun gnus-cache-articles-in-group (group)
+ "Return a sorted list of cached articles in GROUP."
+ (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
+ articles)
+ (when (file-exists-p dir)
+ (setq articles
+ (sort (mapcar (lambda (name) (string-to-int name))
+ (directory-files dir nil "^[0-9]+$" t))
+ '<))
+ ;; Update the cache active file, just to synch more.
+ (when articles
+ (gnus-cache-update-active group (car articles) t)
+ (gnus-cache-update-active group (car (last articles))))
+ articles)))
+
+(defun gnus-cache-braid-nov (group cached &optional file)
+ (let ((cache-buf (get-buffer-create " *gnus-cache*"))
+ beg end)
+ (gnus-cache-save-buffers)
+ (save-excursion
+ (set-buffer cache-buf)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-file-contents (or file (gnus-cache-file-name group ".overview")))
+ (goto-char (point-min))
+ (insert "\n")
+ (goto-char (point-min)))
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while cached
+ (while (and (not (eobp))
+ (< (read (current-buffer)) (car cached)))
+ (forward-line 1))
+ (beginning-of-line)
+ (save-excursion
+ (set-buffer cache-buf)
+ (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
+ nil t)
+ (setq beg (progn (beginning-of-line) (point))
+ end (progn (end-of-line) (point)))
+ (setq beg nil)))
+ (when beg
+ (insert-buffer-substring cache-buf beg end)
+ (insert "\n"))
+ (setq cached (cdr cached)))
+ (kill-buffer cache-buf)))
+
+(defun gnus-cache-braid-heads (group cached)
+ (let ((cache-buf (get-buffer-create " *gnus-cache*")))
+ (save-excursion
+ (set-buffer cache-buf)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer))
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while cached
+ (while (and (not (eobp))
+ (looking-at "2.. +\\([0-9]+\\) ")
+ (< (progn (goto-char (match-beginning 1))
+ (read (current-buffer)))
+ (car cached)))
+ (search-forward "\n.\n" nil 'move))
+ (beginning-of-line)
+ (save-excursion
+ (set-buffer cache-buf)
+ (erase-buffer)
+ (insert-file-contents (gnus-cache-file-name group (car cached)))
+ (goto-char (point-min))
+ (insert "220 ")
+ (princ (car cached) (current-buffer))
+ (insert " Article retrieved.\n")
+ (search-forward "\n\n" nil 'move)
+ (delete-region (point) (point-max))
+ (forward-char -1)
+ (insert "."))
+ (insert-buffer-substring cache-buf)
+ (setq cached (cdr cached)))
+ (kill-buffer cache-buf)))
+
+;;;###autoload
+(defun gnus-jog-cache ()
+ "Go through all groups and put the articles into the cache.
+
+Usage:
+$ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
+ (interactive)
+ (let ((gnus-mark-article-hook nil)
+ (gnus-expert-user t)
+ (nnmail-spool-file nil)
+ (gnus-use-dribble-file nil)
+ (gnus-novice-user nil)
+ (gnus-large-newsgroup nil))
+ ;; Start Gnus.
+ (gnus)
+ ;; Go through all groups...
+ (gnus-group-mark-buffer)
+ (gnus-group-iterate nil
+ (lambda (group)
+ (let (gnus-auto-select-next)
+ (gnus-summary-read-group group nil t)
+ ;; ... and enter the articles into the cache.
+ (when (eq major-mode 'gnus-summary-mode)
+ (gnus-uu-mark-buffer)
+ (gnus-cache-enter-article)
+ (kill-buffer (current-buffer))))))))
+
+(defun gnus-cache-read-active (&optional force)
+ "Read the cache active file."
+ (gnus-make-directory gnus-cache-directory)
+ (if (or (not (file-exists-p gnus-cache-active-file))
+ force)
+ ;; There is no active file, so we generate one.
+ (gnus-cache-generate-active)
+ ;; We simply read the active file.
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert-file-contents gnus-cache-active-file)
+ (gnus-active-to-gnus-format
+ nil (setq gnus-cache-active-hashtb
+ (gnus-make-hashtable
+ (count-lines (point-min) (point-max)))))
+ (setq gnus-cache-active-altered nil))))
+
+(defun gnus-cache-write-active (&optional force)
+ "Write the active hashtb to the active file."
+ (when (or force
+ (and gnus-cache-active-hashtb
+ gnus-cache-active-altered))
+ (nnheader-temp-write gnus-cache-active-file
+ (mapatoms
+ (lambda (sym)
+ (when (and sym (boundp sym))
+ (insert (format "%s %d %d y\n"
+ (symbol-name sym) (cdr (symbol-value sym))
+ (car (symbol-value sym))))))
+ gnus-cache-active-hashtb))
+ ;; Mark the active hashtb as unaltered.
+ (setq gnus-cache-active-altered nil)))
+
+(defun gnus-cache-update-active (group number &optional low)
+ "Update the upper bound of the active info of GROUP to NUMBER.
+If LOW, update the lower bound instead."
+ (let ((active (gnus-gethash group gnus-cache-active-hashtb)))
+ (if (null active)
+ ;; We just create a new active entry for this group.
+ (gnus-sethash group (cons number number) gnus-cache-active-hashtb)
+ ;; Update the lower or upper bound.
+ (if low
+ (setcar active number)
+ (setcdr active number)))
+ ;; Mark the active hashtb as altered.
+ (setq gnus-cache-active-altered t)))
+
+;;;###autoload
+(defun gnus-cache-generate-active (&optional directory)
+ "Generate the cache active file."
+ (interactive)
+ (let* ((top (null directory))
+ (directory (expand-file-name (or directory gnus-cache-directory)))
+ (files (directory-files directory 'full))
+ (group
+ (if top
+ ""
+ (string-match
+ (concat "^" (file-name-as-directory
+ (expand-file-name gnus-cache-directory)))
+ (directory-file-name directory))
+ (nnheader-replace-chars-in-string
+ (substring (directory-file-name directory) (match-end 0))
+ ?/ ?.)))
+ nums alphs)
+ (when top
+ (gnus-message 5 "Generating the cache active file...")
+ (setq gnus-cache-active-hashtb (gnus-make-hashtable 123)))
+ ;; Separate articles from all other files and directories.
+ (while files
+ (if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))
+ (push (string-to-int (file-name-nondirectory (pop files))) nums)
+ (push (pop files) alphs)))
+ ;; If we have nums, then this is probably a valid group.
+ (when (setq nums (sort nums '<))
+ (gnus-sethash group (cons (car nums) (gnus-last-element nums))
+ gnus-cache-active-hashtb))
+ ;; Go through all the other files.
+ (while alphs
+ (when (and (file-directory-p (car alphs))
+ (not (string-match "^\\.\\.?$"
+ (file-name-nondirectory (car alphs)))))
+ ;; We descend directories.
+ (gnus-cache-generate-active (car alphs)))
+ (setq alphs (cdr alphs)))
+ ;; Write the new active file.
+ (when top
+ (gnus-cache-write-active t)
+ (gnus-message 5 "Generating the cache active file...done"))))
+
+;;;###autoload
+(defun gnus-cache-generate-nov-databases (dir)
+ "Generate NOV files recursively starting in DIR."
+ (interactive (list gnus-cache-directory))
+ (gnus-cache-close)
+ (let ((nnml-generate-active-function 'identity))
+ (nnml-generate-nov-databases-1 dir)))
+
+(defun gnus-cache-move-cache (dir)
+ "Move the cache tree to somewhere else."
+ (interactive "FMove the cache tree to: ")
+ (rename-file gnus-cache-directory dir))
+
+(provide 'gnus-cache)
+
+;;; gnus-cache.el ends here
--- /dev/null
+;;; gnus-cite.el --- parse citations in articles for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-art)
+(require 'gnus-range)
+
+;;; Customization:
+
+(defgroup gnus-cite nil
+ "Citation."
+ :prefix "gnus-cite-"
+ :link '(custom-manual "(gnus)Article Highlighting")
+ :group 'gnus-article)
+
+(defcustom gnus-cite-reply-regexp
+ "^\\(Subject: Re\\|In-Reply-To\\|References\\):"
+ "If headers match this regexp it is reasonable to believe that
+article has citations."
+ :group 'gnus-cite
+ :type 'string)
+
+(defcustom gnus-cite-always-check nil
+ "Check article always for citations. Set it t to check all articles."
+ :group 'gnus-cite
+ :type '(choice (const :tag "no" nil)
+ (const :tag "yes" t)))
+
+(defcustom gnus-cited-text-button-line-format "%(%{[...]%}%)\n"
+ "Format of cited text buttons."
+ :group 'gnus-cite
+ :type 'string)
+
+(defcustom gnus-cited-lines-visible nil
+ "The number of lines of hidden cited text to remain visible."
+ :group 'gnus-cite
+ :type '(choice (const :tag "none" nil)
+ integer))
+
+(defcustom gnus-cite-parse-max-size 25000
+ "Maximum article size (in bytes) where parsing citations is allowed.
+Set it to nil to parse all articles."
+ :group 'gnus-cite
+ :type '(choice (const :tag "all" nil)
+ integer))
+
+(defcustom gnus-cite-prefix-regexp
+ "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>"
+ "Regexp matching the longest possible citation prefix on a line."
+ :group 'gnus-cite
+ :type 'regexp)
+
+(defcustom gnus-cite-max-prefix 20
+ "Maximum possible length for a citation prefix."
+ :group 'gnus-cite
+ :type 'integer)
+
+(defcustom gnus-supercite-regexp
+ (concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
+ ">>>>> +\"\\([^\"\n]+\\)\" +==")
+ "Regexp matching normal Supercite attribution lines.
+The first grouping must match prefixes added by other packages."
+ :group 'gnus-cite
+ :type 'regexp)
+
+(defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
+ "Regexp matching mangled Supercite attribution lines.
+The first regexp group should match the Supercite attribution."
+ :group 'gnus-cite
+ :type 'regexp)
+
+(defcustom gnus-cite-minimum-match-count 2
+ "Minimum number of identical prefixes before we believe it's a citation."
+ :group 'gnus-cite
+ :type 'integer)
+
+(defcustom gnus-cite-attribution-prefix
+ "in article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),"
+ "Regexp matching the beginning of an attribution line."
+ :group 'gnus-cite
+ :type 'regexp)
+
+(defcustom gnus-cite-attribution-suffix
+ "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[ \t]*$"
+ "Regexp matching the end of an attribution line.
+The text matching the first grouping will be used as a button."
+ :group 'gnus-cite
+ :type 'regexp)
+
+(defface gnus-cite-attribution-face '((t
+ (:underline t)))
+ "Face used for attribution lines.")
+
+(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
+ "Face used for attribution lines.
+It is merged with the face for the cited text belonging to the attribution."
+ :group 'gnus-cite
+ :type 'face)
+
+(defface gnus-cite-face-1 '((((class color)
+ (background dark))
+ (:foreground "light blue"))
+ (((class color)
+ (background light))
+ (:foreground "MidnightBlue"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defface gnus-cite-face-2 '((((class color)
+ (background dark))
+ (:foreground "light cyan"))
+ (((class color)
+ (background light))
+ (:foreground "firebrick"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defface gnus-cite-face-3 '((((class color)
+ (background dark))
+ (:foreground "light yellow"))
+ (((class color)
+ (background light))
+ (:foreground "dark green"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defface gnus-cite-face-4 '((((class color)
+ (background dark))
+ (:foreground "light pink"))
+ (((class color)
+ (background light))
+ (:foreground "OrangeRed"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defface gnus-cite-face-5 '((((class color)
+ (background dark))
+ (:foreground "pale green"))
+ (((class color)
+ (background light))
+ (:foreground "dark khaki"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defface gnus-cite-face-6 '((((class color)
+ (background dark))
+ (:foreground "beige"))
+ (((class color)
+ (background light))
+ (:foreground "dark violet"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defface gnus-cite-face-7 '((((class color)
+ (background dark))
+ (:foreground "orange"))
+ (((class color)
+ (background light))
+ (:foreground "SteelBlue4"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defface gnus-cite-face-8 '((((class color)
+ (background dark))
+ (:foreground "magenta"))
+ (((class color)
+ (background light))
+ (:foreground "magenta"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defface gnus-cite-face-9 '((((class color)
+ (background dark))
+ (:foreground "violet"))
+ (((class color)
+ (background light))
+ (:foreground "violet"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defface gnus-cite-face-10 '((((class color)
+ (background dark))
+ (:foreground "medium purple"))
+ (((class color)
+ (background light))
+ (:foreground "medium purple"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defface gnus-cite-face-11 '((((class color)
+ (background dark))
+ (:foreground "turquoise"))
+ (((class color)
+ (background light))
+ (:foreground "turquoise"))
+ (t
+ (:italic t)))
+ "Citation face.")
+
+(defcustom gnus-cite-face-list
+ '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4
+ gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8
+ gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11)
+ "List of faces used for highlighting citations.
+
+When there are citations from multiple articles in the same message,
+Gnus will try to give each citation from each article its own face.
+This should make it easier to see who wrote what."
+ :group 'gnus-cite
+ :type '(repeat face))
+
+(defcustom gnus-cite-hide-percentage 50
+ "Only hide excess citation if above this percentage of the body."
+ :group 'gnus-cite
+ :type 'number)
+
+(defcustom gnus-cite-hide-absolute 10
+ "Only hide excess citation if above this number of lines in the body."
+ :group 'gnus-cite
+ :type 'integer)
+
+;;; Internal Variables:
+
+(defvar gnus-cite-article nil)
+
+(defvar gnus-cite-prefix-alist nil)
+;; Alist of citation prefixes.
+;; The cdr is a list of lines with that prefix.
+
+(defvar gnus-cite-attribution-alist nil)
+;; Alist of attribution lines.
+;; The car is a line number.
+;; The cdr is the prefix for the citation started by that line.
+
+(defvar gnus-cite-loose-prefix-alist nil)
+;; Alist of citation prefixes that have no matching attribution.
+;; The cdr is a list of lines with that prefix.
+
+(defvar gnus-cite-loose-attribution-alist nil)
+;; Alist of attribution lines that have no matching citation.
+;; Each member has the form (WROTE IN PREFIX TAG), where
+;; WROTE: is the attribution line number
+;; IN: is the line number of the previous line if part of the same attribution,
+;; PREFIX: Is the citation prefix of the attribution line(s), and
+;; TAG: Is a Supercite tag, if any.
+
+(defvar gnus-cited-text-button-line-format-alist
+ `((?b (marker-position beg) ?d)
+ (?e (marker-position end) ?d)
+ (?l (- end beg) ?d)))
+(defvar gnus-cited-text-button-line-format-spec nil)
+
+;;; Commands:
+
+(defun gnus-article-highlight-citation (&optional force)
+ "Highlight cited text.
+Each citation in the article will be highlighted with a different face.
+The faces are taken from `gnus-cite-face-list'.
+Attribution lines are highlighted with the same face as the
+corresponding citation merged with `gnus-cite-attribution-face'.
+
+Text is considered cited if at least `gnus-cite-minimum-match-count'
+lines matches `gnus-cite-prefix-regexp' with the same prefix.
+
+Lines matching `gnus-cite-attribution-suffix' and perhaps
+`gnus-cite-attribution-prefix' are considered attribution lines."
+ (interactive (list 'force))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (gnus-cite-parse-maybe force)
+ (let ((buffer-read-only nil)
+ (alist gnus-cite-prefix-alist)
+ (faces gnus-cite-face-list)
+ (inhibit-point-motion-hooks t)
+ face entry prefix skip numbers number face-alist)
+ ;; Loop through citation prefixes.
+ (while alist
+ (setq entry (car alist)
+ alist (cdr alist)
+ prefix (car entry)
+ numbers (cdr entry)
+ face (car faces)
+ faces (or (cdr faces) gnus-cite-face-list)
+ face-alist (cons (cons prefix face) face-alist))
+ (while numbers
+ (setq number (car numbers)
+ numbers (cdr numbers))
+ (and (not (assq number gnus-cite-attribution-alist))
+ (not (assq number gnus-cite-loose-attribution-alist))
+ (gnus-cite-add-face number prefix face))))
+ ;; Loop through attribution lines.
+ (setq alist gnus-cite-attribution-alist)
+ (while alist
+ (setq entry (car alist)
+ alist (cdr alist)
+ number (car entry)
+ prefix (cdr entry)
+ skip (gnus-cite-find-prefix number)
+ face (cdr (assoc prefix face-alist)))
+ ;; Add attribution button.
+ (goto-line number)
+ (when (re-search-forward gnus-cite-attribution-suffix
+ (save-excursion (end-of-line 1) (point))
+ t)
+ (gnus-article-add-button (match-beginning 1) (match-end 1)
+ 'gnus-cite-toggle prefix))
+ ;; Highlight attribution line.
+ (gnus-cite-add-face number skip face)
+ (gnus-cite-add-face number skip gnus-cite-attribution-face))
+ ;; Loop through attribution lines.
+ (setq alist gnus-cite-loose-attribution-alist)
+ (while alist
+ (setq entry (car alist)
+ alist (cdr alist)
+ number (car entry)
+ skip (gnus-cite-find-prefix number))
+ (gnus-cite-add-face number skip gnus-cite-attribution-face)))))
+
+(defun gnus-dissect-cited-text ()
+ "Dissect the article buffer looking for cited text."
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (gnus-cite-parse-maybe)
+ (let ((alist gnus-cite-prefix-alist)
+ prefix numbers number marks m)
+ ;; Loop through citation prefixes.
+ (while alist
+ (setq numbers (pop alist)
+ prefix (pop numbers))
+ (while numbers
+ (setq number (pop numbers))
+ (goto-char (point-min))
+ (forward-line number)
+ (push (cons (point-marker) "") marks)
+ (while (and numbers
+ (= (1- number) (car numbers)))
+ (setq number (pop numbers)))
+ (goto-char (point-min))
+ (forward-line (1- number))
+ (push (cons (point-marker) prefix) marks)))
+ ;; Skip to the beginning of the body.
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (push (cons (point-marker) "") marks)
+ ;; Find the end of the body.
+ (goto-char (point-max))
+ (gnus-article-search-signature)
+ (push (cons (point-marker) "") marks)
+ ;; Sort the marks.
+ (setq marks (sort marks 'car-less-than-car))
+ (let ((omarks marks))
+ (setq marks nil)
+ (while (cdr omarks)
+ (if (= (caar omarks) (caadr omarks))
+ (progn
+ (unless (equal (cdar omarks) "")
+ (push (car omarks) marks))
+ (unless (equal (cdadr omarks) "")
+ (push (cadr omarks) marks))
+ (unless (and (equal (cdar omarks) "")
+ (equal (cdadr omarks) "")
+ (not (cddr omarks)))
+ (setq omarks (cdr omarks))))
+ (push (car omarks) marks))
+ (setq omarks (cdr omarks)))
+ (when (car omarks)
+ (push (car omarks) marks))
+ (setq marks (setq m (nreverse marks)))
+ (while (cddr m)
+ (if (and (equal (cdadr m) "")
+ (equal (cdar m) (cdaddr m))
+ (goto-char (caadr m))
+ (forward-line 1)
+ (= (point) (caaddr m)))
+ (setcdr m (cdddr m))
+ (setq m (cdr m))))
+ marks))))
+
+(defun gnus-article-fill-cited-article (&optional force width)
+ "Do word wrapping in the current article.
+If WIDTH (the numerical prefix), use that text width when filling."
+ (interactive (list t current-prefix-arg))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (marks (gnus-dissect-cited-text))
+ (adaptive-fill-mode nil)
+ (filladapt-mode nil)
+ (fill-column (if width (prefix-numeric-value width) fill-column)))
+ (save-restriction
+ (while (cdr marks)
+ (widen)
+ (narrow-to-region (caar marks) (caadr marks))
+ (let ((adaptive-fill-regexp
+ (concat "^" (regexp-quote (cdar marks)) " *"))
+ (fill-prefix (cdar marks)))
+ (fill-region (point-min) (point-max)))
+ (set-marker (caar marks) nil)
+ (setq marks (cdr marks)))
+ (when marks
+ (set-marker (caar marks) nil))
+ ;; All this information is now incorrect.
+ (setq gnus-cite-prefix-alist nil
+ gnus-cite-attribution-alist nil
+ gnus-cite-loose-prefix-alist nil
+ gnus-cite-loose-attribution-alist nil
+ gnus-cite-article nil)))))
+
+(defun gnus-article-hide-citation (&optional arg force)
+ "Toggle hiding of all cited text except attribution lines.
+See the documentation for `gnus-article-highlight-citation'.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+ (interactive (append (gnus-article-hidden-arg) (list 'force)))
+ (gnus-set-format 'cited-text-button t)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (cond
+ ((gnus-article-check-hidden-text 'cite arg)
+ t)
+ ((gnus-article-text-type-exists-p 'cite)
+ (let ((buffer-read-only nil))
+ (gnus-article-hide-text-of-type 'cite)))
+ (t
+ (let ((buffer-read-only nil)
+ (marks (gnus-dissect-cited-text))
+ (inhibit-point-motion-hooks t)
+ (props (nconc (list 'article-type 'cite)
+ gnus-hidden-properties))
+ beg end)
+ (while marks
+ (setq beg nil
+ end nil)
+ (while (and marks (string= (cdar marks) ""))
+ (setq marks (cdr marks)))
+ (when marks
+ (setq beg (caar marks)))
+ (while (and marks (not (string= (cdar marks) "")))
+ (setq marks (cdr marks)))
+ (when marks
+ (setq end (caar marks)))
+ ;; Skip past lines we want to leave visible.
+ (when (and beg end gnus-cited-lines-visible)
+ (goto-char beg)
+ (forward-line gnus-cited-lines-visible)
+ (if (>= (point) end)
+ (setq beg nil)
+ (setq beg (point-marker))))
+ (when (and beg end)
+ (gnus-add-text-properties beg end props)
+ (goto-char beg)
+ (unless (save-excursion (search-backward "\n\n" nil t))
+ (insert "\n"))
+ (put-text-property
+ (point)
+ (progn
+ (gnus-article-add-button
+ (point)
+ (progn (eval gnus-cited-text-button-line-format-spec) (point))
+ `gnus-article-toggle-cited-text (cons beg end))
+ (point))
+ 'article-type 'annotation)
+ (set-marker beg (point)))))))))
+
+(defun gnus-article-toggle-cited-text (region)
+ "Toggle hiding the text in REGION."
+ (let (buffer-read-only)
+ (funcall
+ (if (text-property-any
+ (car region) (1- (cdr region))
+ (car gnus-hidden-properties) (cadr gnus-hidden-properties))
+ 'remove-text-properties 'gnus-add-text-properties)
+ (car region) (cdr region) gnus-hidden-properties)))
+
+(defun gnus-article-hide-citation-maybe (&optional arg force)
+ "Toggle hiding of cited text that has an attribution line.
+If given a negative prefix, always show; if given a positive prefix,
+always hide.
+This will do nothing unless at least `gnus-cite-hide-percentage'
+percent and at least `gnus-cite-hide-absolute' lines of the body is
+cited text with attributions. When called interactively, these two
+variables are ignored.
+See also the documentation for `gnus-article-highlight-citation'."
+ (interactive (append (gnus-article-hidden-arg) (list 'force)))
+ (unless (gnus-article-check-hidden-text 'cite arg)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (gnus-cite-parse-maybe force)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (let ((start (point))
+ (atts gnus-cite-attribution-alist)
+ (buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (hiden 0)
+ total)
+ (goto-char (point-max))
+ (gnus-article-search-signature)
+ (setq total (count-lines start (point)))
+ (while atts
+ (setq hiden (+ hiden (length (cdr (assoc (cdar atts)
+ gnus-cite-prefix-alist))))
+ atts (cdr atts)))
+ (when (or force
+ (and (> (* 100 hiden) (* gnus-cite-hide-percentage total))
+ (> hiden gnus-cite-hide-absolute)))
+ (setq atts gnus-cite-attribution-alist)
+ (while atts
+ (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
+ atts (cdr atts))
+ (while total
+ (setq hiden (car total)
+ total (cdr total))
+ (goto-line hiden)
+ (unless (assq hiden gnus-cite-attribution-alist)
+ (gnus-add-text-properties
+ (point) (progn (forward-line 1) (point))
+ (nconc (list 'article-type 'cite)
+ gnus-hidden-properties))))))))))
+
+(defun gnus-article-hide-citation-in-followups ()
+ "Hide cited text in non-root articles."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((article (cdr gnus-article-current)))
+ (unless (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-article-displayed-root-p article))
+ (gnus-article-hide-citation)))))
+
+;;; Internal functions:
+
+(defun gnus-cite-parse-maybe (&optional force)
+ ;; Parse if the buffer has changes since last time.
+ (if (equal gnus-cite-article gnus-article-current)
+ ()
+ ;;Reset parser information.
+ (setq gnus-cite-prefix-alist nil
+ gnus-cite-attribution-alist nil
+ gnus-cite-loose-prefix-alist nil
+ gnus-cite-loose-attribution-alist nil)
+ ;; Parse if not too large.
+ (if (and (not force)
+ gnus-cite-parse-max-size
+ (> (buffer-size) gnus-cite-parse-max-size))
+ ()
+ (setq gnus-cite-article (cons (car gnus-article-current)
+ (cdr gnus-article-current)))
+ (gnus-cite-parse-wrapper))))
+
+(defun gnus-cite-parse-wrapper ()
+ ;; Wrap chopped gnus-cite-parse
+ (goto-char (point-min))
+ (unless (search-forward "\n\n" nil t)
+ (goto-char (point-max)))
+ (save-excursion
+ (gnus-cite-parse-attributions))
+ ;; Try to avoid check citation if there is no reason to believe
+ ;; that article has citations
+ (if (or gnus-cite-always-check
+ (save-excursion
+ (re-search-backward gnus-cite-reply-regexp nil t))
+ gnus-cite-loose-attribution-alist)
+ (progn (save-excursion
+ (gnus-cite-parse))
+ (save-excursion
+ (gnus-cite-connect-attributions)))))
+
+(defun gnus-cite-parse ()
+ ;; Parse and connect citation prefixes and attribution lines.
+
+ ;; Parse current buffer searching for citation prefixes.
+ (let ((line (1+ (count-lines (point-min) (point))))
+ (case-fold-search t)
+ (max (save-excursion
+ (goto-char (point-max))
+ (gnus-article-search-signature)
+ (point)))
+ alist entry start begin end numbers prefix)
+ ;; Get all potential prefixes in `alist'.
+ (while (< (point) max)
+ ;; Each line.
+ (setq begin (point)
+ end (progn (beginning-of-line 2) (point))
+ start end)
+ (goto-char begin)
+ ;; Ignore standard Supercite attribution prefix.
+ (when (looking-at gnus-supercite-regexp)
+ (if (match-end 1)
+ (setq end (1+ (match-end 1)))
+ (setq end (1+ begin))))
+ ;; Ignore very long prefixes.
+ (when (> end (+ (point) gnus-cite-max-prefix))
+ (setq end (+ (point) gnus-cite-max-prefix)))
+ (while (re-search-forward gnus-cite-prefix-regexp (1- end) t)
+ ;; Each prefix.
+ (setq end (match-end 0)
+ prefix (buffer-substring begin end))
+ (gnus-set-text-properties 0 (length prefix) nil prefix)
+ (setq entry (assoc prefix alist))
+ (if entry
+ (setcdr entry (cons line (cdr entry)))
+ (push (list prefix line) alist))
+ (goto-char begin))
+ (goto-char start)
+ (setq line (1+ line)))
+ ;; We got all the potential prefixes. Now create
+ ;; `gnus-cite-prefix-alist' containing the oldest prefix for each
+ ;; line that appears at least gnus-cite-minimum-match-count
+ ;; times. First sort them by length. Longer is older.
+ (setq alist (sort alist (lambda (a b)
+ (> (length (car a)) (length (car b))))))
+ (while alist
+ (setq entry (car alist)
+ prefix (car entry)
+ numbers (cdr entry)
+ alist (cdr alist))
+ (cond ((null numbers)
+ ;; No lines with this prefix that wasn't also part of
+ ;; a longer prefix.
+ )
+ ((< (length numbers) gnus-cite-minimum-match-count)
+ ;; Too few lines with this prefix. We keep it a bit
+ ;; longer in case it is an exact match for an attribution
+ ;; line, but we don't remove the line from other
+ ;; prefixes.
+ (push entry gnus-cite-prefix-alist))
+ (t
+ (push entry
+ gnus-cite-prefix-alist)
+ ;; Remove articles from other prefixes.
+ (let ((loop alist)
+ current)
+ (while loop
+ (setq current (car loop)
+ loop (cdr loop))
+ (setcdr current
+ (gnus-set-difference (cdr current) numbers)))))))))
+
+(defun gnus-cite-parse-attributions ()
+ (let (al-alist)
+ ;; Parse attributions
+ (while (re-search-forward gnus-cite-attribution-suffix (point-max) t)
+ (let* ((start (match-beginning 0))
+ (end (match-end 0))
+ (wrote (count-lines (point-min) end))
+ (prefix (gnus-cite-find-prefix wrote))
+ ;; Check previous line for an attribution leader.
+ (tag (progn
+ (beginning-of-line 1)
+ (when (looking-at gnus-supercite-secondary-regexp)
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ (in (progn
+ (goto-char start)
+ (and (re-search-backward gnus-cite-attribution-prefix
+ (save-excursion
+ (beginning-of-line 0)
+ (point))
+ t)
+ (not (re-search-forward gnus-cite-attribution-suffix
+ start t))
+ (count-lines (point-min) (1+ (point)))))))
+ (when (eq wrote in)
+ (setq in nil))
+ (goto-char end)
+ ;; don't add duplicates
+ (let ((al (buffer-substring (save-excursion (beginning-of-line 0)
+ (1+ (point)))
+ end)))
+ (if (not (assoc al al-alist))
+ (progn
+ (push (list wrote in prefix tag)
+ gnus-cite-loose-attribution-alist)
+ (push (cons al t) al-alist))))))))
+
+(defun gnus-cite-connect-attributions ()
+ ;; Connect attributions to citations
+
+ ;; No citations have been connected to attribution lines yet.
+ (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil))
+
+ ;; Parse current buffer searching for attribution lines.
+ ;; Find exact supercite citations.
+ (gnus-cite-match-attributions 'small nil
+ (lambda (prefix tag)
+ (when tag
+ (concat "\\`"
+ (regexp-quote prefix) "[ \t]*"
+ (regexp-quote tag) ">"))))
+ ;; Find loose supercite citations after attributions.
+ (gnus-cite-match-attributions 'small t
+ (lambda (prefix tag)
+ (when tag
+ (concat "\\<"
+ (regexp-quote tag)
+ "\\>"))))
+ ;; Find loose supercite citations anywhere.
+ (gnus-cite-match-attributions 'small nil
+ (lambda (prefix tag)
+ (when tag
+ (concat "\\<"
+ (regexp-quote tag)
+ "\\>"))))
+ ;; Find nested citations after attributions.
+ (gnus-cite-match-attributions 'small-if-unique t
+ (lambda (prefix tag)
+ (concat "\\`" (regexp-quote prefix) ".+")))
+ ;; Find nested citations anywhere.
+ (gnus-cite-match-attributions 'small nil
+ (lambda (prefix tag)
+ (concat "\\`" (regexp-quote prefix) ".+")))
+ ;; Remove loose prefixes with too few lines.
+ (let ((alist gnus-cite-loose-prefix-alist)
+ entry)
+ (while alist
+ (setq entry (car alist)
+ alist (cdr alist))
+ (when (< (length (cdr entry)) gnus-cite-minimum-match-count)
+ (setq gnus-cite-prefix-alist
+ (delq entry gnus-cite-prefix-alist)
+ gnus-cite-loose-prefix-alist
+ (delq entry gnus-cite-loose-prefix-alist)))))
+ ;; Find flat attributions.
+ (gnus-cite-match-attributions 'first t nil)
+ ;; Find any attributions (are we getting desperate yet?).
+ (gnus-cite-match-attributions 'first nil nil))
+
+(defun gnus-cite-match-attributions (sort after fun)
+ ;; Match all loose attributions and citations (SORT AFTER FUN) .
+ ;;
+ ;; If SORT is `small', the citation with the shortest prefix will be
+ ;; used, if it is `first' the first prefix will be used, if it is
+ ;; `small-if-unique' the shortest prefix will be used if the
+ ;; attribution line does not share its own prefix with other
+ ;; loose attribution lines, otherwise the first prefix will be used.
+ ;;
+ ;; If AFTER is non-nil, only citations after the attribution line
+ ;; will be considered.
+ ;;
+ ;; If FUN is non-nil, it will be called with the arguments (WROTE
+ ;; PREFIX TAG) and expected to return a regular expression. Only
+ ;; citations whose prefix matches the regular expression will be
+ ;; considered.
+ ;;
+ ;; WROTE is the attribution line number.
+ ;; PREFIX is the attribution line prefix.
+ ;; TAG is the Supercite tag on the attribution line.
+ (let ((atts gnus-cite-loose-attribution-alist)
+ (case-fold-search t)
+ att wrote in prefix tag regexp limit smallest best size)
+ (while atts
+ (setq att (car atts)
+ atts (cdr atts)
+ wrote (nth 0 att)
+ in (nth 1 att)
+ prefix (nth 2 att)
+ tag (nth 3 att)
+ regexp (if fun (funcall fun prefix tag) "")
+ size (cond ((eq sort 'small) t)
+ ((eq sort 'first) nil)
+ (t (< (length (gnus-cite-find-loose prefix)) 2)))
+ limit (if after wrote -1)
+ smallest 1000000
+ best nil)
+ (let ((cites gnus-cite-loose-prefix-alist)
+ cite candidate numbers first compare)
+ (while cites
+ (setq cite (car cites)
+ cites (cdr cites)
+ candidate (car cite)
+ numbers (cdr cite)
+ first (apply 'min numbers)
+ compare (if size (length candidate) first))
+ (and (> first limit)
+ regexp
+ (string-match regexp candidate)
+ (< compare smallest)
+ (setq best cite
+ smallest compare))))
+ (if (null best)
+ ()
+ (setq gnus-cite-loose-attribution-alist
+ (delq att gnus-cite-loose-attribution-alist))
+ (push (cons wrote (car best)) gnus-cite-attribution-alist)
+ (when in
+ (push (cons in (car best)) gnus-cite-attribution-alist))
+ (when (memq best gnus-cite-loose-prefix-alist)
+ (let ((loop gnus-cite-prefix-alist)
+ (numbers (cdr best))
+ current)
+ (setq gnus-cite-loose-prefix-alist
+ (delq best gnus-cite-loose-prefix-alist))
+ (while loop
+ (setq current (car loop)
+ loop (cdr loop))
+ (if (eq current best)
+ ()
+ (setcdr current (gnus-set-difference (cdr current) numbers))
+ (when (null (cdr current))
+ (setq gnus-cite-loose-prefix-alist
+ (delq current gnus-cite-loose-prefix-alist)
+ atts (delq current atts)))))))))))
+
+(defun gnus-cite-find-loose (prefix)
+ ;; Return a list of loose attribution lines prefixed by PREFIX.
+ (let* ((atts gnus-cite-loose-attribution-alist)
+ att line lines)
+ (while atts
+ (setq att (car atts)
+ line (car att)
+ atts (cdr atts))
+ (when (string-equal (gnus-cite-find-prefix line) prefix)
+ (push line lines)))
+ lines))
+
+(defun gnus-cite-add-face (number prefix face)
+ ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
+ (when face
+ (let ((inhibit-point-motion-hooks t)
+ from to)
+ (goto-line number)
+ (unless (eobp);; Sometimes things become confused.
+ (forward-char (length prefix))
+ (skip-chars-forward " \t")
+ (setq from (point))
+ (end-of-line 1)
+ (skip-chars-backward " \t")
+ (setq to (point))
+ (when (< from to)
+ (gnus-overlay-put (gnus-make-overlay from to) 'face face))))))
+
+(defun gnus-cite-toggle (prefix)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
+ (inhibit-point-motion-hooks t)
+ number)
+ (while numbers
+ (setq number (car numbers)
+ numbers (cdr numbers))
+ (goto-line number)
+ (cond ((get-text-property (point) 'invisible)
+ (remove-text-properties (point) (progn (forward-line 1) (point))
+ gnus-hidden-properties))
+ ((assq number gnus-cite-attribution-alist))
+ (t
+ (gnus-add-text-properties
+ (point) (progn (forward-line 1) (point))
+ (nconc (list 'article-type 'cite)
+ gnus-hidden-properties))))))))
+
+(defun gnus-cite-find-prefix (line)
+ ;; Return citation prefix for LINE.
+ (let ((alist gnus-cite-prefix-alist)
+ (prefix "")
+ entry)
+ (while alist
+ (setq entry (car alist)
+ alist (cdr alist))
+ (when (memq line (cdr entry))
+ (setq prefix (car entry))))
+ prefix))
+
+(gnus-add-shutdown 'gnus-cache-close 'gnus)
+
+(defun gnus-cache-close ()
+ (setq gnus-cite-prefix-alist nil))
+
+(gnus-ems-redefine)
+
+(provide 'gnus-cite)
+
+;;; gnus-cite.el ends here
--- /dev/null
+;;; gnus-cus.el --- customization commands for Gnus
+;;
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'wid-edit)
+(require 'gnus-score)
+
+;;; Widgets:
+
+;; There should be special validation for this.
+(define-widget 'gnus-email-address 'string
+ "An email address")
+
+(defun gnus-custom-mode ()
+ "Major mode for editing Gnus customization buffers.
+
+The following commands are available:
+
+\\[widget-forward] Move to next button or editable field.
+\\[widget-backward] Move to previous button or editable field.
+\\[widget-button-click] Activate button under the mouse pointer.
+\\[widget-button-press] Activate button under point.
+
+Entry to this mode calls the value of `gnus-custom-mode-hook'
+if that value is non-nil."
+ (kill-all-local-variables)
+ (setq major-mode 'gnus-custom-mode
+ mode-name "Gnus Customize")
+ (use-local-map widget-keymap)
+ (run-hooks 'gnus-custom-mode-hook))
+
+;;; Group Customization:
+
+(defconst gnus-group-parameters
+ '((to-address (gnus-email-address :tag "To Address") "\
+This will be used when doing followups and posts.
+
+This is primarily useful in mail groups that represent closed
+mailing lists--mailing lists where it's expected that everybody that
+writes to the mailing list is subscribed to it. Since using this
+parameter ensures that the mail only goes to the mailing list itself,
+it means that members won't receive two copies of your followups.
+
+Using `to-address' will actually work whether the group is foreign or
+not. Let's say there's a group on the server that is called
+`fa.4ad-l'. This is a real newsgroup, but the server has gotten the
+articles from a mail-to-news gateway. Posting directly to this group
+is therefore impossible--you have to send mail to the mailing list
+address instead.")
+
+ (to-list (gnus-email-address :tag "To List") "\
+This address will be used when doing a `a' in the group.
+
+It is totally ignored when doing a followup--except that if it is
+present in a news group, you'll get mail group semantics when doing
+`f'.")
+
+ (broken-reply-to (const :tag "Broken Reply To" t) "\
+Ignore `Reply-To' headers in this group.
+
+That can be useful if you're reading a mailing list group where the
+listserv has inserted `Reply-To' headers that point back to the
+listserv itself. This is broken behavior. So there!")
+
+ (to-group (string :tag "To Group") "\
+All posts will be send to the specified group.")
+
+ (gcc-self (choice :tag "GCC"
+ :value t
+ (const t)
+ (const none)
+ (string :format "%v" :hide-front-space t)) "\
+Specify default value for GCC header.
+
+If this symbol is present in the group parameter list and set to `t',
+new composed messages will be `Gcc''d to the current group. If it is
+present and set to `none', no `Gcc:' header will be generated, if it
+is present and a string, this string will be inserted literally as a
+`gcc' header (this symbol takes precedence over any default `Gcc'
+rules as described later).")
+
+ (auto-expire (const :tag "Automatic Expire" t) "\
+All articles that are read will be marked as expirable.")
+
+ (total-expire (const :tag "Total Expire" t) "\
+All read articles will be put through the expiry process
+
+This happens even if they are not marked as expirable.
+Use with caution.")
+
+ (expiry-wait (choice :tag "Expire Wait"
+ :value never
+ (const never)
+ (const immediate)
+ (number :hide-front-space t
+ :format "%v")) "\
+When to expire.
+
+Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function'
+when expiring expirable messages. The value can either be a number of
+days (not necessarily an integer) or the symbols `never' or
+`immediate'.")
+
+ (score-file (file :tag "Score File") "\
+Make the specified file into the current score file.
+This means that all score commands you issue will end up in this file.")
+
+ (adapt-file (file :tag "Adapt File") "\
+Make the specified file into the current adaptive file.
+All adaptive score entries will be put into this file.")
+
+ (admin-address (gnus-email-address :tag "Admin Address") "\
+Administration address for a mailing list.
+
+When unsubscribing to a mailing list you should never send the
+unsubscription notice to the mailing list itself. Instead, you'd
+send messages to the administrative address. This parameter allows
+you to put the admin address somewhere convenient.")
+
+ (display (choice :tag "Display"
+ :value default
+ (const all)
+ (const default)) "\
+Which articles to display on entering the group.
+
+`all'
+ Display all articles, both read and unread.
+
+`default'
+ Display the default visible articles, which normally includes
+ unread and ticked articles.")
+
+ (comment (string :tag "Comment") "\
+An arbitrary comment on the group."))
+ "Alist of valid group parameters.
+
+Each entry has the form (NAME TYPE DOC), where NAME is the parameter
+itself (a symbol), TYPE is the parameters type (a sexp widget), and
+DOC is a documentation string for the parameter.")
+
+(defvar gnus-custom-params)
+(defvar gnus-custom-method)
+(defvar gnus-custom-group)
+
+(defun gnus-group-customize (group &optional part)
+ "Edit the group on the current line."
+ (interactive (list (gnus-group-group-name)))
+ (let ((part (or part 'info))
+ info
+ (types (mapcar (lambda (entry)
+ `(cons :format "%v%h\n"
+ :doc ,(nth 2 entry)
+ (const :format "" ,(nth 0 entry))
+ ,(nth 1 entry)))
+ gnus-group-parameters)))
+ (unless group
+ (error "No group on current line"))
+ (unless (setq info (gnus-get-info group))
+ (error "Killed group; can't be edited"))
+ ;; Ready.
+ (kill-buffer (get-buffer-create "*Gnus Customize*"))
+ (switch-to-buffer (get-buffer-create "*Gnus Customize*"))
+ (gnus-custom-mode)
+ (make-local-variable 'gnus-custom-group)
+ (setq gnus-custom-group group)
+ (widget-insert "Customize the ")
+ (widget-create 'info-link
+ :help-echo "Push me to learn more."
+ :tag "group parameters"
+ "(gnus)Group Parameters")
+ (widget-insert " for <")
+ (widget-insert group)
+ (widget-insert "> and press ")
+ (widget-create 'push-button
+ :tag "done"
+ :help-echo "Push me when done customizing."
+ :action 'gnus-group-customize-done)
+ (widget-insert ".\n\n")
+ (make-local-variable 'gnus-custom-params)
+ (setq gnus-custom-params
+ (widget-create 'group
+ :value (gnus-info-params info)
+ `(set :inline t
+ :greedy t
+ :tag "Parameters"
+ :format "%t:\n%h%v"
+ :doc "\
+These special paramerters are recognized by Gnus.
+Check the [ ] for the parameters you want to apply to this group, then
+edit the value to suit your taste."
+ ,@types)
+ '(repeat :inline t
+ :tag "Variables"
+ :format "%t:\n%h%v%i\n\n"
+ :doc "\
+Set variables local to the group you are entering.
+
+If you want to turn threading off in `news.answers', you could put
+`(gnus-show-threads nil)' in the group parameters of that group.
+`gnus-show-threads' will be made into a local variable in the summary
+buffer you enter, and the form `nil' will be `eval'ed there.
+
+This can also be used as a group-specific hook function, if you'd
+like. If you want to hear a beep when you enter a group, you could
+put something like `(dummy-variable (ding))' in the parameters of that
+group. `dummy-variable' will be set to the result of the `(ding)'
+form, but who cares?"
+ (group :value (nil nil)
+ (symbol :tag "Variable")
+ (sexp :tag
+ "Value")))
+
+ '(repeat :inline t
+ :tag "Unknown entries"
+ sexp)))
+ (widget-insert "\n\nYou can also edit the ")
+ (widget-create 'info-link
+ :tag "select method"
+ :help-echo "Push me to learn more about select methods."
+ "(gnus)Select Methods")
+ (widget-insert " for the group.\n")
+ (setq gnus-custom-method
+ (widget-create 'sexp
+ :tag "Method"
+ :value (gnus-info-method info)))
+ (use-local-map widget-keymap)
+ (widget-setup)))
+
+(defun gnus-group-customize-done (&rest ignore)
+ "Apply changes and bury the buffer."
+ (interactive)
+ (gnus-group-edit-group-done 'params gnus-custom-group
+ (widget-value gnus-custom-params))
+ (gnus-group-edit-group-done 'method gnus-custom-group
+ (widget-value gnus-custom-method))
+ (bury-buffer))
+
+;;; Score Customization:
+
+(defconst gnus-score-parameters
+ '((mark (number :tag "Mark") "\
+The value of this entry should be a number.
+Any articles with a score lower than this number will be marked as read.")
+
+ (expunge (number :tag "Expunge") "\
+The value of this entry should be a number.
+Any articles with a score lower than this number will be removed from
+the summary buffer.")
+
+ (mark-and-expunge (number :tag "Mark-and-expunge") "\
+The value of this entry should be a number.
+Any articles with a score lower than this number will be marked as
+read and removed from the summary buffer.")
+
+ (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\
+The value of this entry should be a number.
+All articles that belong to a thread that has a total score below this
+number will be marked as read and removed from the summary buffer.
+`gnus-thread-score-function' says how to compute the total score
+for a thread.")
+
+ (files (repeat :tag "Files" file) "\
+The value of this entry should be any number of file names.
+These files are assumed to be score files as well, and will be loaded
+the same way this one was.")
+
+ (exclude-files (repeat :tag "Exclude-files" file) "\
+The clue of this entry should be any number of files.
+These files will not be loaded, even though they would normally be so,
+for some reason or other.")
+
+ (eval (sexp :tag "Eval" :value nil) "\
+The value of this entry will be `eval'el.
+This element will be ignored when handling global score files.")
+
+ (read-only (boolean :tag "Read-only" :value t) "\
+Read-only score files will not be updated or saved.
+Global score files should feature this atom.")
+
+ (orphan (number :tag "Orphan") "\
+The value of this entry should be a number.
+Articles that do not have parents will get this number added to their
+scores. Imagine you follow some high-volume newsgroup, like
+`comp.lang.c'. Most likely you will only follow a few of the threads,
+also want to see any new threads.
+
+You can do this with the following two score file entries:
+
+ (orphan -500)
+ (mark-and-expunge -100)
+
+When you enter the group the first time, you will only see the new
+threads. You then raise the score of the threads that you find
+interesting (with `I T' or `I S'), and ignore (`C y') the rest.
+Next time you enter the group, you will see new articles in the
+interesting threads, plus any new threads.
+
+I.e.---the orphan score atom is for high-volume groups where there
+exist a few interesting threads which can't be found automatically
+by ordinary scoring rules.")
+
+ (adapt (choice :tag "Adapt"
+ (const t)
+ (const ignore)
+ (sexp :format "%v"
+ :hide-front-space t)) "\
+This entry controls the adaptive scoring.
+If it is `t', the default adaptive scoring rules will be used. If it
+is `ignore', no adaptive scoring will be performed on this group. If
+it is a list, this list will be used as the adaptive scoring rules.
+If it isn't present, or is something other than `t' or `ignore', the
+default adaptive scoring rules will be used. If you want to use
+adaptive scoring on most groups, you'd set `gnus-use-adaptive-scoring'
+to `t', and insert an `(adapt ignore)' in the groups where you do not
+want adaptive scoring. If you only want adaptive scoring in a few
+groups, you'd set `gnus-use-adaptive-scoring' to `nil', and insert
+`(adapt t)' in the score files of the groups where you want it.")
+
+ (adapt-file (file :tag "Adapt-file") "\
+All adaptive score entries will go to the file named by this entry.
+It will also be applied when entering the group. This atom might
+be handy if you want to adapt on several groups at once, using the
+same adaptive file for a number of groups.")
+
+ (local (repeat :tag "Local"
+ (group :value (nil nil)
+ (symbol :tag "Variable")
+ (sexp :tag "Value"))) "\
+The value of this entry should be a list of `(VAR VALUE)' pairs.
+Each VAR will be made buffer-local to the current summary buffer,
+and set to the value specified. This is a convenient, if somewhat
+strange, way of setting variables in some groups if you don't like
+hooks much.")
+ (touched (sexp :format "Touched\n") "Internal variable."))
+ "Alist of valid symbolic score parameters.
+
+Each entry has the form (NAME TYPE DOC), where NAME is the parameter
+itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a
+documentation string for the parameter.")
+
+(define-widget 'gnus-score-string 'group
+ "Edit score entries for string-valued headers."
+ :convert-widget 'gnus-score-string-convert)
+
+(defun gnus-score-string-convert (widget)
+ ;; Set args appropriately.
+ (let* ((tag (widget-get widget :tag))
+ (item `(const :format "" :value ,(downcase tag)))
+ (match '(string :tag "Match"))
+ (score '(choice :tag "Score"
+ (const :tag "default" nil)
+ (integer :format "%v"
+ :hide-front-space t)))
+ (expire '(choice :tag "Expire"
+ (const :tag "off" nil)
+ (integer :format "%v"
+ :hide-front-space t)))
+ (type '(choice :tag "Type"
+ :value s
+ ;; I should really create a forgiving :match
+ ;; function for each type below, that only
+ ;; looked at the first letter.
+ (const :tag "Regexp" r)
+ (const :tag "Regexp (fixed case)" R)
+ (const :tag "Substring" s)
+ (const :tag "Substring (fixed case)" S)
+ (const :tag "Exact" e)
+ (const :tag "Exact (fixed case)" E)
+ (const :tag "Word" w)
+ (const :tag "Word (fixed case)" W)
+ (const :tag "default" nil)))
+ (group `(group ,match ,score ,expire ,type))
+ (doc (concat (or (widget-get widget :doc)
+ (concat "Change score based on the " tag
+ " header.\n"))
+ "
+You can have an arbitrary number of score entries for this header,
+each score entry has four elements:
+
+1. The \"match element\". This should be the string to look for in the
+ header.
+
+2. The \"score element\". This number should be an integer in the
+ neginf to posinf interval. This number is added to the score
+ of the article if the match is successful. If this element is
+ not present, the `gnus-score-interactive-default-score' number
+ will be used instead. This is 1000 by default.
+
+3. The \"date element\". This date says when the last time this score
+ entry matched, which provides a mechanism for expiring the
+ score entries. It this element is not present, the score
+ entry is permanent. The date is represented by the number of
+ days since December 31, 1 ce.
+
+4. The \"type element\". This element specifies what function should
+ be used to see whether this score entry matches the article.
+
+ There are the regexp, as well as substring types, and exact match,
+ and word match types. If this element is not present, Gnus will
+ assume that substring matching should be used. There is case
+ sensitive variants of all match types.")))
+ (widget-put widget :args `(,item
+ (repeat :inline t
+ :indent 0
+ :tag ,tag
+ :doc ,doc
+ :format "%t:\n%h%v%i\n\n"
+ (choice :format "%v"
+ :value ("" nil nil s)
+ ,group
+ sexp)))))
+ widget)
+
+(define-widget 'gnus-score-integer 'group
+ "Edit score entries for integer-valued headers."
+ :convert-widget 'gnus-score-integer-convert)
+
+(defun gnus-score-integer-convert (widget)
+ ;; Set args appropriately.
+ (let* ((tag (widget-get widget :tag))
+ (item `(const :format "" :value ,(downcase tag)))
+ (match '(integer :tag "Match"))
+ (score '(choice :tag "Score"
+ (const :tag "default" nil)
+ (integer :format "%v"
+ :hide-front-space t)))
+ (expire '(choice :tag "Expire"
+ (const :tag "off" nil)
+ (integer :format "%v"
+ :hide-front-space t)))
+ (type '(choice :tag "Type"
+ :value <
+ (const <)
+ (const >)
+ (const =)
+ (const >=)
+ (const <=)))
+ (group `(group ,match ,score ,expire ,type))
+ (doc (concat (or (widget-get widget :doc)
+ (concat "Change score based on the " tag
+ " header.")))))
+ (widget-put widget :args `(,item
+ (repeat :inline t
+ :indent 0
+ :tag ,tag
+ :doc ,doc
+ :format "%t:\n%h%v%i\n\n"
+ ,group))))
+ widget)
+
+(define-widget 'gnus-score-date 'group
+ "Edit score entries for date-valued headers."
+ :convert-widget 'gnus-score-date-convert)
+
+(defun gnus-score-date-convert (widget)
+ ;; Set args appropriately.
+ (let* ((tag (widget-get widget :tag))
+ (item `(const :format "" :value ,(downcase tag)))
+ (match '(string :tag "Match"))
+ (score '(choice :tag "Score"
+ (const :tag "default" nil)
+ (integer :format "%v"
+ :hide-front-space t)))
+ (expire '(choice :tag "Expire"
+ (const :tag "off" nil)
+ (integer :format "%v"
+ :hide-front-space t)))
+ (type '(choice :tag "Type"
+ :value regexp
+ (const regexp)
+ (const before)
+ (const at)
+ (const after)))
+ (group `(group ,match ,score ,expire ,type))
+ (doc (concat (or (widget-get widget :doc)
+ (concat "Change score based on the " tag
+ " header."))
+ "
+For the Date header we have three kinda silly match types: `before',
+`at' and `after'. I can't really imagine this ever being useful, but,
+like, it would feel kinda silly not to provide this function. Just in
+case. You never know. Better safe than sorry. Once burnt, twice
+shy. Don't judge a book by its cover. Never not have sex on a first
+date. (I have been told that at least one person, and I quote,
+\"found this function indispensable\", however.)
+
+A more useful match type is `regexp'. With it, you can match the date
+string using a regular expression. The date is normalized to ISO8601
+compact format first---`YYYYMMDDTHHMMSS'. If you want to match all
+articles that have been posted on April 1st in every year, you could
+use `....0401.........' as a match string, for instance. (Note that
+the date is kept in its original time zone, so this will match
+articles that were posted when it was April 1st where the article was
+posted from. Time zones are such wholesome fun for the whole family,
+eh?")))
+ (widget-put widget :args `(,item
+ (repeat :inline t
+ :indent 0
+ :tag ,tag
+ :doc ,doc
+ :format "%t:\n%h%v%i\n\n"
+ ,group))))
+ widget)
+
+(defvar gnus-custom-scores)
+(defvar gnus-custom-score-alist)
+
+(defun gnus-score-customize (file)
+ "Customize score file FILE."
+ (interactive (list gnus-current-score-file))
+ (let ((scores (gnus-score-load file))
+ (types (mapcar (lambda (entry)
+ `(group :format "%v%h\n"
+ :doc ,(nth 2 entry)
+ (const :format "" ,(nth 0 entry))
+ ,(nth 1 entry)))
+ gnus-score-parameters)))
+ ;; Ready.
+ (kill-buffer (get-buffer-create "*Gnus Customize*"))
+ (switch-to-buffer (get-buffer-create "*Gnus Customize*"))
+ (gnus-custom-mode)
+ (make-local-variable 'gnus-custom-score-alist)
+ (setq gnus-custom-score-alist scores)
+ (widget-insert "Customize the ")
+ (widget-create 'info-link
+ :help-echo "Push me to learn more."
+ :tag "score entries"
+ "(gnus)Score File Format")
+ (widget-insert " for\n\t")
+ (widget-insert file)
+ (widget-insert "\nand press ")
+ (widget-create 'push-button
+ :tag "done"
+ :help-echo "Push me when done customizing."
+ :action 'gnus-score-customize-done)
+ (widget-insert ".\n
+Check the [ ] for the entries you want to apply to this score file, then
+edit the value to suit your taste. Don't forget to mark the checkbox,
+if you do all your changes will be lost. ")
+ (widget-create 'push-button
+ :action (lambda (&rest ignore)
+ (require 'gnus-audio)
+ (gnus-audio-play "Evil_Laugh.au"))
+ "Bhahahah!")
+ (widget-insert "\n\n")
+ (make-local-variable 'gnus-custom-scores)
+ (setq gnus-custom-scores
+ (widget-create 'group
+ :value scores
+ `(checklist :inline t
+ :greedy t
+ (gnus-score-string :tag "From")
+ (gnus-score-string :tag "Subject")
+ (gnus-score-string :tag "References")
+ (gnus-score-string :tag "Xref")
+ (gnus-score-string :tag "Message-ID")
+ (gnus-score-integer :tag "Lines")
+ (gnus-score-integer :tag "Chars")
+ (gnus-score-date :tag "Date")
+ (gnus-score-string :tag "Head"
+ :doc "\
+Match all headers in the article.
+
+Using one of `Head', `Body', `All' will slow down scoring considerable.
+")
+ (gnus-score-string :tag "Body"
+ :doc "\
+Match the body sans header of the article.
+
+Using one of `Head', `Body', `All' will slow down scoring considerable.
+")
+ (gnus-score-string :tag "All"
+ :doc "\
+Match the entire article, including both headers and body.
+
+Using one of `Head', `Body', `All' will slow down scoring
+considerable.
+")
+ (gnus-score-string :tag
+ "Followup"
+ :doc "\
+Score all followups to the specified authors.
+
+This entry is somewhat special, in that it will match the `From:'
+header, and affect the score of not only the matching articles, but
+also all followups to the matching articles. This allows you
+e.g. increase the score of followups to your own articles, or decrease
+the score of followups to the articles of some known trouble-maker.
+")
+ (gnus-score-string :tag "Thread"
+ :doc "\
+Add a score entry on all articles that are part of a thread.
+
+This match key works along the same lines as the `Followup' match key.
+If you say that you want to score on a (sub-)thread that is started by
+an article with a `Message-ID' X, then you add a `thread' match. This
+will add a new `thread' match for each article that has X in its
+`References' header. (These new `thread' matches will use the
+`Message-ID's of these matching articles.) This will ensure that you
+can raise/lower the score of an entire thread, even though some
+articles in the thread may not have complete `References' headers.
+Note that using this may lead to undeterministic scores of the
+articles in the thread.
+")
+ ,@types)
+ '(repeat :inline t
+ :tag "Unknown entries"
+ sexp)))
+ (use-local-map widget-keymap)
+ (widget-setup)))
+
+(defun gnus-score-customize-done (&rest ignore)
+ "Reset the score alist with the present value."
+ (let ((alist gnus-custom-score-alist)
+ (value (widget-value gnus-custom-scores)))
+ (setcar alist (car value))
+ (setcdr alist (cdr value))
+ (gnus-score-set 'touched '(t) alist))
+ (bury-buffer))
+
+;;; The End:
+
+(provide 'gnus-cus)
+
+;;; gnus-cus.el ends here
+
--- /dev/null
+;;; gnus-demon.el --- daemonic Gnus behaviour
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-int)
+(require 'nnheader)
+(eval-and-compile
+ (if (string-match "XEmacs" (emacs-version))
+ (require 'itimer)
+ (require 'timer)))
+
+(defgroup gnus-demon nil
+ "Demonic behaviour."
+ :group 'gnus)
+
+(defcustom gnus-demon-handlers nil
+ "Alist of daemonic handlers to be run at intervals.
+Each handler is a list on the form
+
+\(FUNCTION TIME IDLE)
+
+FUNCTION is the function to be called.
+TIME is the number of `gnus-demon-timestep's between each call.
+If nil, never call. If t, call each `gnus-demon-timestep'.
+If IDLE is t, only call if Emacs has been idle for a while. If IDLE
+is a number, only call when Emacs has been idle more than this number
+of `gnus-demon-timestep's. If IDLE is nil, don't care about
+idleness. If IDLE is a number and TIME is nil, then call once each
+time Emacs has been idle for IDLE `gnus-demon-timestep's."
+ :group 'gnus-demon
+ :type '(repeat (list function
+ (choice :tag "Time"
+ (const :tag "never" nil)
+ (const :tag "one" t)
+ (integer :tag "steps" 1))
+ (choice :tag "Idle"
+ (const :tag "don't care" nil)
+ (const :tag "for a while" t)
+ (integer :tag "steps" 1)))))
+
+(defcustom gnus-demon-timestep 60
+ "*Number of seconds in each demon timestep."
+ :group 'gnus-demon
+ :type 'integer)
+
+;;; Internal variables.
+
+(defvar gnus-demon-timer nil)
+(defvar gnus-demon-idle-has-been-called nil)
+(defvar gnus-demon-idle-time 0)
+(defvar gnus-demon-handler-state nil)
+(defvar gnus-demon-last-keys nil)
+(defvar gnus-inhibit-demon nil
+ "*If non-nil, no daemonic function will be run.")
+
+(eval-and-compile
+ (autoload 'timezone-parse-date "timezone")
+ (autoload 'timezone-make-arpa-date "timezone"))
+
+;;; Functions.
+
+(defun gnus-demon-add-handler (function time idle)
+ "Add the handler FUNCTION to be run at TIME and IDLE."
+ ;; First remove any old handlers that use this function.
+ (gnus-demon-remove-handler function)
+ ;; Then add the new one.
+ (push (list function time idle) gnus-demon-handlers)
+ (gnus-demon-init))
+
+(defun gnus-demon-remove-handler (function &optional no-init)
+ "Remove the handler FUNCTION from the list of handlers."
+ (setq gnus-demon-handlers
+ (delq (assq function gnus-demon-handlers)
+ gnus-demon-handlers))
+ (unless no-init
+ (gnus-demon-init)))
+
+(defun gnus-demon-init ()
+ "Initialize the Gnus daemon."
+ (interactive)
+ (gnus-demon-cancel)
+ (when gnus-demon-handlers
+ ;; Set up the timer.
+ (setq gnus-demon-timer
+ (nnheader-run-at-time
+ gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
+ ;; Reset control variables.
+ (setq gnus-demon-handler-state
+ (mapcar
+ (lambda (handler)
+ (list (car handler) (gnus-demon-time-to-step (nth 1 handler))
+ (nth 2 handler)))
+ gnus-demon-handlers))
+ (setq gnus-demon-idle-time 0)
+ (setq gnus-demon-idle-has-been-called nil)
+ (setq gnus-use-demon t)))
+
+(gnus-add-shutdown 'gnus-demon-cancel 'gnus)
+
+(defun gnus-demon-cancel ()
+ "Cancel any Gnus daemons."
+ (interactive)
+ (when gnus-demon-timer
+ (nnheader-cancel-timer gnus-demon-timer))
+ (setq gnus-demon-timer nil
+ gnus-use-demon nil
+ gnus-demon-idle-has-been-called nil)
+ (condition-case ()
+ (nnheader-cancel-function-timers 'gnus-demon)
+ (error t)))
+
+(defun gnus-demon-is-idle-p ()
+ "Whether Emacs is idle or not."
+ ;; We do this simply by comparing the 100 most recent keystrokes
+ ;; with the ones we had last time. If they are the same, one might
+ ;; guess that Emacs is indeed idle. This only makes sense if one
+ ;; calls this function seldom -- like once a minute, which is what
+ ;; we do here.
+ (let ((keys (recent-keys)))
+ (or (equal keys gnus-demon-last-keys)
+ (progn
+ (setq gnus-demon-last-keys keys)
+ nil))))
+
+(defun gnus-demon-time-to-step (time)
+ "Find out how many seconds to TIME, which is on the form \"17:43\"."
+ (if (not (stringp time))
+ time
+ (let* ((now (current-time))
+ ;; obtain NOW as discrete components -- make a vector for speed
+ (nowParts (apply 'vector (decode-time now)))
+ ;; obtain THEN as discrete components
+ (thenParts (timezone-parse-time time))
+ (thenHour (string-to-int (elt thenParts 0)))
+ (thenMin (string-to-int (elt thenParts 1)))
+ ;; convert time as elements into number of seconds since EPOCH.
+ (then (encode-time 0
+ thenMin
+ thenHour
+ ;; If THEN is earlier than NOW, make it
+ ;; same time tomorrow. Doc for encode-time
+ ;; says that this is OK.
+ (+ (elt nowParts 3)
+ (if (or (< thenHour (elt nowParts 2))
+ (and (= thenHour (elt nowParts 2))
+ (<= thenMin (elt nowParts 1))))
+ 1 0))
+ (elt nowParts 4)
+ (elt nowParts 5)
+ (elt nowParts 6)
+ (elt nowParts 7)
+ (elt nowParts 8)))
+ ;; calculate number of seconds between NOW and THEN
+ (diff (+ (* 65536 (- (car then) (car now)))
+ (- (cadr then) (cadr now)))))
+ ;; return number of timesteps in the number of seconds
+ (round (/ diff gnus-demon-timestep)))))
+
+(defun gnus-demon ()
+ "The Gnus daemon that takes care of running all Gnus handlers."
+ ;; Increase or reset the time Emacs has been idle.
+ (if (gnus-demon-is-idle-p)
+ (incf gnus-demon-idle-time)
+ (setq gnus-demon-idle-time 0)
+ (setq gnus-demon-idle-has-been-called nil))
+ ;; Disable all daemonic stuff if we're in the minibuffer
+ (when (and (not (window-minibuffer-p (selected-window)))
+ (not gnus-inhibit-demon))
+ ;; Then we go through all the handler and call those that are
+ ;; sufficiently ripe.
+ (let ((handlers gnus-demon-handler-state)
+ (gnus-inhibit-demon t)
+ handler time idle)
+ (while handlers
+ (setq handler (pop handlers))
+ (cond
+ ((numberp (setq time (nth 1 handler)))
+ ;; These handlers use a regular timeout mechanism. We decrease
+ ;; the timer if it hasn't reached zero yet.
+ (unless (zerop time)
+ (setcar (nthcdr 1 handler) (decf time)))
+ (and (zerop time) ; If the timer now is zero...
+ ;; Test for appropriate idleness
+ (progn
+ (setq idle (nth 2 handler))
+ (cond
+ ((null idle) t) ; Don't care about idle.
+ ((numberp idle) ; Numerical idle...
+ (< idle gnus-demon-idle-time)) ; Idle timed out.
+ (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle.
+ ;; So we call the handler.
+ (progn
+ (ignore-errors (funcall (car handler)))
+ ;; And reset the timer.
+ (setcar (nthcdr 1 handler)
+ (gnus-demon-time-to-step
+ (nth 1 (assq (car handler) gnus-demon-handlers)))))))
+ ;; These are only supposed to be called when Emacs is idle.
+ ((null (setq idle (nth 2 handler)))
+ ;; We do nothing.
+ )
+ ((and (not (numberp idle))
+ (gnus-demon-is-idle-p))
+ ;; We want to call this handler each and every time that
+ ;; Emacs is idle.
+ (ignore-errors (funcall (car handler))))
+ (t
+ ;; We want to call this handler only if Emacs has been idle
+ ;; for a specified number of timesteps.
+ (and (not (memq (car handler) gnus-demon-idle-has-been-called))
+ (< idle gnus-demon-idle-time)
+ (gnus-demon-is-idle-p)
+ (progn
+ (ignore-errors (funcall (car handler)))
+ ;; Make sure the handler won't be called once more in
+ ;; this idle-cycle.
+ (push (car handler) gnus-demon-idle-has-been-called)))))))))
+
+(defun gnus-demon-add-nocem ()
+ "Add daemonic NoCeM handling to Gnus."
+ (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30))
+
+(defun gnus-demon-scan-nocem ()
+ "Scan NoCeM groups for NoCeM messages."
+ (save-window-excursion
+ (gnus-nocem-scan-groups)))
+
+(defun gnus-demon-add-disconnection ()
+ "Add daemonic server disconnection to Gnus."
+ (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
+
+(defun gnus-demon-close-connections ()
+ (save-window-excursion
+ (gnus-close-backends)))
+
+(defun gnus-demon-add-scanmail ()
+ "Add daemonic scanning of mail from the mail backends."
+ (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
+
+(defun gnus-demon-scan-mail ()
+ (save-window-excursion
+ (let ((servers gnus-opened-servers)
+ server)
+ (while (setq server (car (pop servers)))
+ (and (gnus-check-backend-function 'request-scan (car server))
+ (or (gnus-server-opened server)
+ (gnus-open-server server))
+ (gnus-request-scan nil server))))))
+
+(defun gnus-demon-add-rescan ()
+ "Add daemonic scanning of new articles from all backends."
+ (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
+
+(defun gnus-demon-scan-news ()
+ (save-window-excursion
+ (when (gnus-alive-p)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-group-get-new-news)))))
+
+(defun gnus-demon-add-scan-timestamps ()
+ "Add daemonic updating of timestamps in empty newgroups."
+ (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
+
+(defun gnus-demon-scan-timestamps ()
+ "Set the timestamp on all newsgroups with no unread and no ticked articles."
+ (when (gnus-alive-p)
+ (let ((cur-time (current-time))
+ (newsrc (cdr gnus-newsrc-alist))
+ info group unread has-ticked)
+ (while (setq info (pop newsrc))
+ (setq group (gnus-info-group info)
+ unread (gnus-group-unread group)
+ has-ticked (cdr (assq 'tick (gnus-info-marks info))))
+ (when (and (numberp unread)
+ (= unread 0)
+ (not has-ticked))
+ (gnus-group-set-parameter group 'timestamp cur-time))))))
+
+(provide 'gnus-demon)
+
+;;; gnus-demon.el ends here
--- /dev/null
+;;; gnus-draft.el --- draft message support for Gnus
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(require 'gnus-sum)
+(require 'message)
+(require 'gnus-msg)
+(require 'nndraft)
+(eval-when-compile (require 'cl))
+
+;;; Draft minor mode
+
+(defvar gnus-draft-mode nil
+ "Minor mode for providing a draft summary buffers.")
+
+(defvar gnus-draft-mode-map nil)
+
+(unless gnus-draft-mode-map
+ (setq gnus-draft-mode-map (make-sparse-keymap))
+
+ (gnus-define-keys gnus-draft-mode-map
+ "Dt" gnus-draft-toggle-sending
+ "De" gnus-draft-edit-message
+ "Ds" gnus-draft-send-message
+ "DS" gnus-draft-send-all-messages))
+
+(defun gnus-draft-make-menu-bar ()
+ (unless (boundp 'gnus-draft-menu)
+ (easy-menu-define
+ gnus-draft-menu gnus-draft-mode-map ""
+ '("Drafts"
+ ["Toggle whether to send" gnus-draft-toggle-sending t]))))
+
+(defun gnus-draft-mode (&optional arg)
+ "Minor mode for providing a draft summary buffers.
+
+\\{gnus-draft-mode-map}"
+ (interactive "P")
+ (when (eq major-mode 'gnus-summary-mode)
+ (when (set (make-local-variable 'gnus-draft-mode)
+ (if (null arg) (not gnus-draft-mode)
+ (> (prefix-numeric-value arg) 0)))
+ ;; Set up the menu.
+ (when (gnus-visual-p 'draft-menu 'menu)
+ (gnus-draft-make-menu-bar))
+ (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map)
+ (run-hooks 'gnus-draft-mode-hook))))
+
+;;; Commands
+
+(defun gnus-draft-toggle-sending (article)
+ "Toggle whether to send an article or not."
+ (interactive (list (gnus-summary-article-number)))
+ (if (gnus-draft-article-sendable-p article)
+ (progn
+ (push article gnus-newsgroup-unsendable)
+ (gnus-summary-mark-article article gnus-unsendable-mark))
+ (setq gnus-newsgroup-unsendable
+ (delq article gnus-newsgroup-unsendable))
+ (gnus-summary-mark-article article gnus-unread-mark))
+ (gnus-summary-position-point))
+
+(defun gnus-draft-edit-message ()
+ "Enter a mail/post buffer to edit and send the draft."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((article (gnus-summary-article-number)))
+ (gnus-draft-setup article gnus-newsgroup-name)
+ (push
+ `((lambda ()
+ (when (buffer-name (get-buffer ,gnus-summary-buffer))
+ (save-excursion
+ (set-buffer (get-buffer ,gnus-summary-buffer))
+ (gnus-cache-possibly-remove-article ,article nil nil nil t)
+ (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
+ message-send-actions)))
+
+(defun gnus-draft-send-message (&optional n)
+ "Send the current draft."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((articles (gnus-summary-work-articles n))
+ article)
+ (while (setq article (pop articles))
+ (gnus-summary-remove-process-mark article)
+ (unless (memq article gnus-newsgroup-unsendable)
+ (gnus-draft-send article gnus-newsgroup-name)
+ (gnus-summary-mark-article article gnus-canceled-mark)))))
+
+(defun gnus-draft-send (article &optional group)
+ "Send message ARTICLE."
+ (gnus-draft-setup article (or group "nndraft:queue"))
+ (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
+ (message-send-and-exit)))
+
+(defun gnus-draft-send-all-messages ()
+ "Send all the sendable drafts."
+ (interactive)
+ (gnus-uu-mark-buffer)
+ (gnus-draft-send-message))
+
+(defun gnus-group-send-drafts ()
+ "Send all sendable articles from the queue group."
+ (interactive)
+ (gnus-request-group "nndraft:queue")
+ (save-excursion
+ (let ((articles (nndraft-articles))
+ (unsendable (gnus-uncompress-range
+ (cdr (assq 'unsend
+ (gnus-info-marks
+ (gnus-get-info "nndraft:queue"))))))
+ article)
+ (while (setq article (pop articles))
+ (unless (memq article unsendable)
+ (gnus-draft-send article))))))
+
+;;; Utility functions
+
+;;;!!!If this is byte-compiled, it fails miserably.
+;;;!!!I have no idea why.
+
+(progn
+(defun gnus-draft-setup (narticle group)
+ (gnus-setup-message 'forward
+ (let ((article narticle))
+ (message-mail)
+ (erase-buffer)
+ (message "%s %s" group article)
+ (if (not (gnus-request-restore-buffer article group))
+ (error "Couldn't restore the article")
+ ;; Insert the separator.
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ (forward-line 1))))))
+
+(defun gnus-draft-article-sendable-p (article)
+ "Say whether ARTICLE is sendable."
+ (not (memq article gnus-newsgroup-unsendable)))
+
+(provide 'gnus-draft)
+
+;;; gnus-draft.el ends here
--- /dev/null
+;;; gnus-dup.el --- suppression of duplicate articles in Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package tries to mark articles as read the second time the
+;; user reads a copy. This is useful if the server doesn't support
+;; Xref properly, or if the user reads the same group from several
+;; servers.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-art)
+
+(defgroup gnus-duplicate nil
+ "Suppression of duplicate articles."
+ :group 'gnus)
+
+(defcustom gnus-save-duplicate-list nil
+ "*If non-nil, save the duplicate list when shutting down Gnus.
+If nil, duplicate suppression will only work on duplicates
+seen in the same session."
+ :group 'gnus-duplicate
+ :type 'boolean)
+
+(defcustom gnus-duplicate-list-length 10000
+ "*The number of Message-IDs to keep in the duplicate suppression list."
+ :group 'gnus-duplicate
+ :type 'integer)
+
+(defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression")
+ "*The name of the file to store the duplicate suppression list."
+ :group 'gnus-duplicate
+ :type 'file)
+
+;;; Internal variables
+
+(defvar gnus-dup-list nil)
+(defvar gnus-dup-hashtb nil)
+
+(defvar gnus-dup-list-dirty nil)
+
+;;;
+;;; Starting and stopping
+;;;
+
+(gnus-add-shutdown 'gnus-dup-close 'gnus)
+
+(defun gnus-dup-close ()
+ "Possibly save the duplicate suppression list and shut down the subsystem."
+ (gnus-dup-save)
+ (setq gnus-dup-list nil
+ gnus-dup-hashtb nil
+ gnus-dup-list-dirty nil))
+
+(defun gnus-dup-open ()
+ "Possibly read the duplicate suppression list and start the subsystem."
+ (if gnus-save-duplicate-list
+ (gnus-dup-read)
+ (setq gnus-dup-list nil))
+ (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length))
+ ;; Enter all Message-IDs into the hash table.
+ (let ((list gnus-dup-list)
+ (obarray gnus-dup-hashtb))
+ (while list
+ (intern (pop list)))))
+
+(defun gnus-dup-read ()
+ "Read the duplicate suppression list."
+ (setq gnus-dup-list nil)
+ (when (file-exists-p gnus-duplicate-file)
+ (load gnus-duplicate-file t t t)))
+
+(defun gnus-dup-save ()
+ "Save the duplicate suppression list."
+ (when (and gnus-save-duplicate-list
+ gnus-dup-list-dirty)
+ (nnheader-temp-write gnus-duplicate-file
+ (gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list))))
+ (setq gnus-dup-list-dirty nil))
+
+;;;
+;;; Interface functions
+;;;
+
+(defun gnus-dup-enter-articles ()
+ "Enter articles from the current group for future duplicate suppression."
+ (unless gnus-dup-list
+ (gnus-dup-open))
+ (setq gnus-dup-list-dirty t) ; mark list for saving
+ (let ((data gnus-newsgroup-data)
+ datum msgid)
+ ;; Enter the Message-IDs of all read articles into the list
+ ;; and hash table.
+ (while (setq datum (pop data))
+ (when (and (not (gnus-data-pseudo-p datum))
+ (> (gnus-data-number datum) 0)
+ (not (memq (gnus-data-number datum) gnus-newsgroup-unreads))
+ (not (= (gnus-data-mark datum) gnus-canceled-mark))
+ (setq msgid (mail-header-id (gnus-data-header datum)))
+ (not (nnheader-fake-message-id-p msgid))
+ (not (intern-soft msgid gnus-dup-hashtb)))
+ (push msgid gnus-dup-list)
+ (intern msgid gnus-dup-hashtb))))
+ ;; Chop off excess Message-IDs from the list.
+ (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
+ (when end
+ (setcdr end nil))))
+
+(defun gnus-dup-suppress-articles ()
+ "Mark duplicate articles as read."
+ (unless gnus-dup-list
+ (gnus-dup-open))
+ (gnus-message 6 "Suppressing duplicates...")
+ (let ((headers gnus-newsgroup-headers)
+ number header)
+ (while (setq header (pop headers))
+ (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb)
+ (gnus-summary-article-unread-p (mail-header-number header)))
+ (setq gnus-newsgroup-unreads
+ (delq (setq number (mail-header-number header))
+ gnus-newsgroup-unreads))
+ (push (cons number gnus-duplicate-mark)
+ gnus-newsgroup-reads))))
+ (gnus-message 6 "Suppressing duplicates...done"))
+
+(defun gnus-dup-unsuppress-article (article)
+ "Stop suppression of ARTICLE."
+ (let ((id (mail-header-id (gnus-data-header (gnus-data-find article)))))
+ (when id
+ (setq gnus-dup-list-dirty t)
+ (setq gnus-dup-list (delete id gnus-dup-list))
+ (unintern id gnus-dup-hashtb))))
+
+(provide 'gnus-dup)
+
+;;; gnus-dup.el ends here
--- /dev/null
+;;; gnus-eform.el --- a mode for editing forms for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(require 'gnus-win)
+
+;;;
+;;; Editing forms
+;;;
+
+(defgroup gnus-edit-form nil
+ "A mode for editing forms."
+ :group 'gnus)
+
+(defcustom gnus-edit-form-mode-hook nil
+ "Hook run in `gnus-edit-form-mode' buffers."
+ :group 'gnus-edit-form
+ :type 'hook)
+
+(defcustom gnus-edit-form-menu-hook nil
+ "Hook run when creating menus in `gnus-edit-form-mode' buffers."
+ :group 'gnus-edit-form
+ :type 'hook)
+
+;;; Internal variables
+
+(defvar gnus-edit-form-done-function nil)
+(defvar gnus-edit-form-buffer "*Gnus edit form*")
+
+(defvar gnus-edit-form-mode-map nil)
+(unless gnus-edit-form-mode-map
+ (setq gnus-edit-form-mode-map (copy-keymap emacs-lisp-mode-map))
+ (gnus-define-keys gnus-edit-form-mode-map
+ "\C-c\C-c" gnus-edit-form-done
+ "\C-c\C-k" gnus-edit-form-exit))
+
+(defun gnus-edit-form-make-menu-bar ()
+ (unless (boundp 'gnus-edit-form-menu)
+ (easy-menu-define
+ gnus-edit-form-menu gnus-edit-form-mode-map ""
+ '("Edit Form"
+ ["Exit and save changes" gnus-edit-form-done t]
+ ["Exit" gnus-edit-form-exit t]))
+ (run-hooks 'gnus-edit-form-menu-hook)))
+
+(defun gnus-edit-form-mode ()
+ "Major mode for editing forms.
+It is a slightly enhanced emacs-lisp-mode.
+
+\\{gnus-edit-form-mode-map}"
+ (interactive)
+ (when (gnus-visual-p 'group-menu 'menu)
+ (gnus-edit-form-make-menu-bar))
+ (kill-all-local-variables)
+ (setq major-mode 'gnus-edit-form-mode)
+ (setq mode-name "Edit Form")
+ (use-local-map gnus-edit-form-mode-map)
+ (make-local-variable 'gnus-edit-form-done-function)
+ (make-local-variable 'gnus-prev-winconf)
+ (run-hooks 'gnus-edit-form-mode-hook))
+
+(defun gnus-edit-form (form documentation exit-func)
+ "Edit FORM in a new buffer.
+Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning
+of the buffer."
+ (let ((winconf (current-window-configuration)))
+ (set-buffer (get-buffer-create gnus-edit-form-buffer))
+ (gnus-configure-windows 'edit-form)
+ (gnus-add-current-to-buffer-list)
+ (gnus-edit-form-mode)
+ (setq gnus-prev-winconf winconf)
+ (setq gnus-edit-form-done-function exit-func)
+ (erase-buffer)
+ (insert documentation)
+ (unless (bolp)
+ (insert "\n"))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (insert ";;; ")
+ (forward-line 1))
+ (insert ";; Type `C-c C-c' after you've finished editing.\n")
+ (insert "\n")
+ (let ((p (point)))
+ (pp form (current-buffer))
+ (insert "\n")
+ (goto-char p))))
+
+(defun gnus-edit-form-done ()
+ "Update changes and kill the current buffer."
+ (interactive)
+ (goto-char (point-min))
+ (let ((form (read (current-buffer)))
+ (func gnus-edit-form-done-function))
+ (gnus-edit-form-exit)
+ (funcall func form)))
+
+(defun gnus-edit-form-exit ()
+ "Kill the current buffer."
+ (interactive)
+ (let ((winconf gnus-prev-winconf))
+ (kill-buffer (current-buffer))
+ (set-window-configuration winconf)))
+
+(provide 'gnus-eform)
+
+;;; gnus-eform.el ends here
--- /dev/null
+;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+;;; Function aliases later to be redefined for XEmacs usage.
+
+(defvar gnus-xemacs (string-match "XEmacs\\|Lucid" emacs-version)
+ "Non-nil if running under XEmacs.")
+
+(defvar gnus-mouse-2 [mouse-2])
+(defvar gnus-down-mouse-2 [down-mouse-2])
+(defvar gnus-mode-line-modified
+ (if (or gnus-xemacs
+ (< emacs-major-version 20))
+ '("--**-" . "-----")
+ '("**" "--")))
+
+(eval-and-compile
+ (autoload 'gnus-xmas-define "gnus-xmas")
+ (autoload 'gnus-xmas-redefine "gnus-xmas")
+ (autoload 'appt-select-lowest-window "appt"))
+
+(or (fboundp 'mail-file-babyl-p)
+ (fset 'mail-file-babyl-p 'rmail-file-p))
+
+;;; Mule functions.
+
+(defun gnus-mule-cite-add-face (number prefix face)
+ ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
+ (when face
+ (let ((inhibit-point-motion-hooks t)
+ from to)
+ (goto-line number)
+ (if (boundp 'MULE)
+ (forward-char (chars-in-string prefix))
+ (forward-char (length prefix)))
+ (skip-chars-forward " \t")
+ (setq from (point))
+ (end-of-line 1)
+ (skip-chars-backward " \t")
+ (setq to (point))
+ (when (< from to)
+ (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))
+
+(defun gnus-mule-max-width-function (el max-width)
+ (` (let* ((val (eval (, el)))
+ (valstr (if (numberp val)
+ (int-to-string val) val)))
+ (if (> (length valstr) (, max-width))
+ (truncate-string valstr (, max-width))
+ valstr))))
+
+(defun gnus-encode-coding-string (string system)
+ string)
+
+(defun gnus-decode-coding-string (string system)
+ string)
+
+(eval-and-compile
+ (if (string-match "XEmacs\\|Lucid" emacs-version)
+ nil
+
+ (defvar gnus-mouse-face-prop 'mouse-face
+ "Property used for highlighting mouse regions."))
+
+ (cond
+ ((string-match "XEmacs\\|Lucid" emacs-version)
+ (gnus-xmas-define))
+
+ ((or (not (boundp 'emacs-minor-version))
+ (< emacs-minor-version 30))
+ ;; Remove the `intangible' prop.
+ (let ((props (and (boundp 'gnus-hidden-properties)
+ gnus-hidden-properties)))
+ (while (and props (not (eq (car (cdr props)) 'intangible)))
+ (setq props (cdr props)))
+ (when props
+ (setcdr props (cdr (cdr (cdr props))))))
+ (unless (fboundp 'buffer-substring-no-properties)
+ (defun buffer-substring-no-properties (beg end)
+ (format "%s" (buffer-substring beg end)))))
+
+ ((boundp 'MULE)
+ (provide 'gnusutil))))
+
+(eval-and-compile
+ (cond
+ ((not window-system)
+ (defun gnus-dummy-func (&rest args))
+ (let ((funcs '(mouse-set-point set-face-foreground
+ set-face-background x-popup-menu)))
+ (while funcs
+ (unless (fboundp (car funcs))
+ (fset (car funcs) 'gnus-dummy-func))
+ (setq funcs (cdr funcs))))))
+ (unless (fboundp 'file-regular-p)
+ (defun file-regular-p (file)
+ (and (not (file-directory-p file))
+ (not (file-symlink-p file))
+ (file-exists-p file))))
+ (unless (fboundp 'face-list)
+ (defun face-list (&rest args))))
+
+(eval-and-compile
+ (let ((case-fold-search t))
+ (cond
+ ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type))
+ (setq nnheader-file-name-translation-alist
+ (append nnheader-file-name-translation-alist
+ '((?: . ?_)
+ (?+ . ?-))))))))
+
+(defvar gnus-tmp-unread)
+(defvar gnus-tmp-replied)
+(defvar gnus-tmp-score-char)
+(defvar gnus-tmp-indentation)
+(defvar gnus-tmp-opening-bracket)
+(defvar gnus-tmp-lines)
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-closing-bracket)
+(defvar gnus-tmp-subject-or-nil)
+
+(defun gnus-ems-redefine ()
+ (cond
+ ((string-match "XEmacs\\|Lucid" emacs-version)
+ (gnus-xmas-redefine))
+
+ ((featurep 'mule)
+ ;; Mule and new Emacs definitions
+
+ ;; [Note] Now there are three kinds of mule implementations,
+ ;; original MULE, XEmacs/mule and beta version of Emacs including
+ ;; some mule features. Unfortunately these API are different. In
+ ;; particular, Emacs (including original MULE) and XEmacs are
+ ;; quite different.
+ ;; Predicates to check are following:
+ ;; (boundp 'MULE) is t only if MULE (original; anything older than
+ ;; Mule 2.3) is running.
+ ;; (featurep 'mule) is t when every mule variants are running.
+
+ ;; These implementations may be able to share between original
+ ;; MULE and beta version of new Emacs. In addition, it is able to
+ ;; detect XEmacs/mule by (featurep 'mule) and to check variable
+ ;; `emacs-version'. In this case, implementation for XEmacs/mule
+ ;; may be able to share between XEmacs and XEmacs/mule.
+
+ (defalias 'gnus-truncate-string 'truncate-string)
+
+ (defvar gnus-summary-display-table nil
+ "Display table used in summary mode buffers.")
+ (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)
+ (fset 'gnus-max-width-function 'gnus-mule-max-width-function)
+ (fset 'gnus-summary-set-display-table 'ignore)
+ (fset 'gnus-encode-coding-string 'encode-coding-string)
+ (fset 'gnus-decode-coding-string 'decode-coding-string)
+
+ (when (boundp 'gnus-check-before-posting)
+ (setq gnus-check-before-posting
+ (delq 'long-lines
+ (delq 'control-chars gnus-check-before-posting))))
+
+ (defun gnus-summary-line-format-spec ()
+ (insert gnus-tmp-unread gnus-tmp-replied
+ gnus-tmp-score-char gnus-tmp-indentation)
+ (put-text-property
+ (point)
+ (progn
+ (insert
+ gnus-tmp-opening-bracket
+ (format "%4d: %-20s"
+ gnus-tmp-lines
+ (if (> (length gnus-tmp-name) 20)
+ (truncate-string gnus-tmp-name 20)
+ gnus-tmp-name))
+ gnus-tmp-closing-bracket)
+ (point))
+ gnus-mouse-face-prop gnus-mouse-face)
+ (insert " " gnus-tmp-subject-or-nil "\n"))
+ )))
+
+(defun gnus-region-active-p ()
+ "Say whether the region is active."
+ (and (boundp 'transient-mark-mode)
+ transient-mark-mode
+ (boundp 'mark-active)
+ mark-active))
+
+(defun gnus-add-minor-mode (mode name map)
+ (if (fboundp 'add-minor-mode)
+ (add-minor-mode mode name map)
+ (unless (assq mode minor-mode-alist)
+ (push `(,mode ,name) minor-mode-alist))
+ (unless (assq mode minor-mode-map-alist)
+ (push (cons mode map)
+ minor-mode-map-alist))))
+
+(defun gnus-x-splash ()
+ "Show a splash screen using a pixmap in the current buffer."
+ (let ((dir (nnheader-find-etc-directory "gnus"))
+ pixmap file height beg i)
+ (save-excursion
+ (switch-to-buffer (get-buffer-create gnus-group-buffer))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (when (and dir
+ (file-exists-p (setq file (concat dir "x-splash"))))
+ (nnheader-temp-write nil
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (ignore-errors
+ (setq pixmap (read (current-buffer))))))
+ (when pixmap
+ (erase-buffer)
+ (unless (facep 'gnus-splash)
+ (make-face 'gnus-splash))
+ (setq height (/ (car pixmap) (frame-char-height))
+ width (/ (cadr pixmap) (frame-char-width)))
+ (set-face-foreground 'gnus-splash "ForestGreen")
+ (set-face-stipple 'gnus-splash pixmap)
+ (insert-char ?\n (* (/ (window-height) 2 height) height))
+ (setq i height)
+ (while (> i 0)
+ (insert-char ? (* (+ (/ (window-width) 2 width) 1) width))
+ (setq beg (point))
+ (insert-char ? width)
+ (set-text-properties beg (point) '(face gnus-splash))
+ (insert "\n")
+ (decf i))
+ (goto-char (point-min))
+ (sit-for 0))))))
+
+(provide 'gnus-ems)
+
+;; Local Variables:
+;; byte-compile-warnings: '(redefine callargs)
+;; End:
+
+;;; gnus-ems.el ends here
--- /dev/null
+;;; gnus-gl.el --- an interface to GroupLens for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Brad Miller <bmiller@cs.umn.edu>
+;; Keywords: news, score
+
+;; 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; GroupLens software and documentation is copyright (c) 1995 by Paul
+;; Resnick (Massachusetts Institute of Technology); Brad Miller, John
+;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota),
+;; and David Maltz (Carnegie-Mellon University).
+;;
+;; Permission to use, copy, modify, and distribute this documentation
+;; for non-commercial and commercial purposes without fee is hereby
+;; granted provided that this copyright notice and permission notice
+;; appears in all copies and that the names of the individuals and
+;; institutions holding this copyright are not used in advertising or
+;; publicity pertaining to this software without specific, written
+;; prior permission. The copyright holders make no representations
+;; about the suitability of this software and documentation for any
+;; purpose. It is provided ``as is'' without express or implied
+;; warranty.
+;;
+;; The copyright holders request that they be notified of
+;; modifications of this code. Please send electronic mail to
+;; grouplens@cs.umn.edu for more information or to announce derived
+;; works.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Author: Brad Miller
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; User Documentation:
+;; To use GroupLens you must load this file.
+;; You must also register a pseudonym with the Better Bit Bureau.
+;; http://www.cs.umn.edu/Research/GroupLens
+;;
+;; ---------------- For your .emacs or .gnus file ----------------
+;;
+;; As of version 2.5, grouplens now works as a minor mode of
+;; gnus-summary-mode. To get make that work you just need a couple of
+;; hooks.
+;; (setq gnus-use-grouplens t)
+;; (setq grouplens-pseudonym "")
+;; (setq grouplens-bbb-host "grouplens.cs.umn.edu")
+;;
+;; (setq gnus-summary-default-score 0)
+;;
+;; USING GROUPLENS
+;; How do I Rate an article??
+;; Before you type n to go to the next article, hit a number from 1-5
+;; Type r in the summary buffer and you will be prompted.
+;; Note that when you're in grouplens-minor-mode 'r' masks the
+;; usual reply binding for 'r'
+;;
+;; What if, Gasp, I find a bug???
+;; Please type M-x gnus-gl-submit-bug-report. This will set up a
+;; mail buffer with the state of variables and buffers that will help
+;; me debug the problem. A short description up front would help too!
+;;
+;; How do I display the prediction for an article:
+;; If you set the gnus-summary-line-format as shown above, the score
+;; (prediction) will be shown automatically.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Programmer Notes
+;; 10/9/95
+;; gnus-scores-articles contains the articles
+;; When scoring is done, the call tree looks something like:
+;; gnus-possibly-score-headers
+;; ==> gnus-score-headers
+;; ==> gnus-score-load-file
+;; ==> get-all-mids (from the eval form)
+;;
+;; it would be nice to have one that gets called after all the other
+;; headers have been scored.
+;; we may want a variable gnus-grouplens-scale-factor
+;; and gnus-grouplens-offset this would probably be either -3 or 0
+;; to make the scores centered around zero or not.
+;; Notes 10/12/95
+;; According to Lars, Norse god of gnus, the simple way to insert a
+;; call to an external function is to have a function added to the
+;; variable gnus-score-find-files-function This new function
+;; gnus-grouplens-score-alist will return a core alist that
+;; has (("message-id" ("<message-id-xxxx>" score) ("<message-id-xxxy>" score))
+;; This seems like it would be pretty inefficient, though workable.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TODO
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; 3. Add some more ways to rate messages
+;; 4. Better error handling for token timeouts.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bugs
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus-score)
+(require 'gnus)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; User variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar gnus-summary-grouplens-line-format
+ "%U\%R\%z%l%I\%(%[%4L: %-20,20n%]%) %s\n"
+ "*The line format spec in summary GroupLens mode buffers.")
+
+(defvar grouplens-pseudonym ""
+ "User's pseudonym.
+This pseudonym is obtained during the registration process")
+
+(defvar grouplens-bbb-host "grouplens.cs.umn.edu"
+ "Host where the bbbd is running" )
+
+(defvar grouplens-bbb-port 9000
+ "Port where the bbbd is listening" )
+
+(defvar grouplens-newsgroups
+ '("comp.groupware" "comp.human-factors" "comp.lang.c++"
+ "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy"
+ "comp.os.linux.announce" "comp.os.linux.answers"
+ "comp.os.linux.development" "comp.os.linux.development.apps"
+ "comp.os.linux.development.system" "comp.os.linux.hardware"
+ "comp.os.linux.help" "comp.os.linux.m68k" "comp.os.linux.misc"
+ "comp.os.linux.networking" "comp.os.linux.setup" "comp.os.linux.x"
+ "mn.general" "rec.arts.movies" "rec.arts.movies.current-films"
+ "rec.food.recipes" "rec.humor")
+ "*Groups that are part of the GroupLens experiment.")
+
+(defvar grouplens-prediction-display 'prediction-spot
+ "valid values are:
+ prediction-spot -- an * corresponding to the prediction between 1 and 5,
+ confidence-interval -- a numeric confidence interval
+ prediction-bar -- |##### | the longer the bar, the better the article,
+ confidence-bar -- | ----- } the prediction is in the middle of the bar,
+ confidence-spot -- ) * | the spot gets bigger with more confidence,
+ prediction-num -- plain-old numeric value,
+ confidence-plus-minus -- prediction +/i confidence")
+
+(defvar grouplens-score-offset 0
+ "Offset the prediction by this value.
+Setting this variable to -2 would have the following effect on
+GroupLens scores:
+
+ 1 --> -2
+ 2 --> -1
+ 3 --> 0
+ 4 --> 1
+ 5 --> 2
+
+The reason is that a user might want to do this is to combine
+GroupLens predictions with scores calculated by other score methods.")
+
+(defvar grouplens-score-scale-factor 1
+ "This variable allows the user to magnify the effect of GroupLens scores.
+The scale factor is applied after the offset.")
+
+(defvar gnus-grouplens-override-scoring 'override
+ "Tell GroupLens to override the normal Gnus scoring mechanism.
+GroupLens scores can be combined with gnus scores in one of three ways.
+'override -- just use grouplens predictions for grouplens groups
+'combine -- combine grouplens scores with gnus scores
+'separate -- treat grouplens scores completely separate from gnus")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Program global variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar grouplens-bbb-token nil
+ "Current session token number")
+
+(defvar grouplens-bbb-process nil
+ "Process Id of current bbbd network stream process")
+
+(defvar grouplens-bbb-buffer nil
+ "Buffer associated with the BBBD process")
+
+(defvar grouplens-rating-alist nil
+ "Current set of message-id rating pairs")
+
+(defvar grouplens-current-hashtable nil
+ "A hashtable to hold predictions from the BBB")
+
+(defvar grouplens-current-group nil)
+
+;;(defvar bbb-alist nil)
+
+(defvar bbb-timeout-secs 10
+ "Number of seconds to wait for some response from the BBB.
+If this times out we give up and assume that something has died..." )
+
+(defvar grouplens-previous-article nil
+ "Message-ID of the last article read.")
+
+(defvar bbb-read-point)
+(defvar bbb-response-point)
+
+(defun bbb-renew-hash-table ()
+ (setq grouplens-current-hashtable (make-vector 100 0)))
+
+(bbb-renew-hash-table)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Utility Functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun bbb-connect-to-bbbd (host port)
+ (unless grouplens-bbb-buffer
+ (setq grouplens-bbb-buffer
+ (get-buffer-create (format " *BBBD trace: %s*" host)))
+ (save-excursion
+ (set-buffer grouplens-bbb-buffer)
+ (make-local-variable 'bbb-read-point)
+ (make-local-variable 'bbb-response-point)
+ (setq bbb-read-point (point-min))))
+
+ ;; if an old process is still running for some reason, kill it
+ (when grouplens-bbb-process
+ (ignore-errors
+ (when (eq 'open (process-status grouplens-bbb-process))
+ (set-process-buffer grouplens-bbb-process nil)
+ (delete-process grouplens-bbb-process))))
+
+ ;; clear the trace buffer of old output
+ (save-excursion
+ (set-buffer grouplens-bbb-buffer)
+ (erase-buffer))
+
+ ;; open the connection to the server
+ (catch 'done
+ (condition-case error
+ (setq grouplens-bbb-process
+ (open-network-stream "BBBD" grouplens-bbb-buffer host port))
+ (error (gnus-message 3 "Error: Failed to connect to BBB")
+ nil))
+ (and (null grouplens-bbb-process)
+ (throw 'done nil))
+ (save-excursion
+ (set-buffer grouplens-bbb-buffer)
+ (setq bbb-read-point (point-min))
+ (or (bbb-read-response grouplens-bbb-process)
+ (throw 'done nil))))
+
+ ;; return the process
+ grouplens-bbb-process)
+
+(defun bbb-send-command (process command)
+ (goto-char (point-max))
+ (insert command)
+ (insert "\r\n")
+ (setq bbb-read-point (point))
+ (setq bbb-response-point (point))
+ (set-marker (process-mark process) (point)) ; process output also comes here
+ (process-send-string process command)
+ (process-send-string process "\r\n")
+ (process-send-eof process))
+
+(defun bbb-read-response (process)
+ "This function eats the initial response of OK or ERROR from the BBB."
+ (let ((case-fold-search nil)
+ match-end)
+ (goto-char bbb-read-point)
+ (while (and (not (search-forward "\r\n" nil t))
+ (accept-process-output process bbb-timeout-secs))
+ (goto-char bbb-read-point))
+ (setq match-end (point))
+ (goto-char bbb-read-point)
+ (setq bbb-read-point match-end)
+ (looking-at "OK")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Login Functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun bbb-login ()
+ "return the token number if login is successful, otherwise return nil"
+ (interactive)
+ (setq grouplens-bbb-token nil)
+ (if (not (equal grouplens-pseudonym ""))
+ (let ((bbb-process
+ (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
+ (if bbb-process
+ (save-excursion
+ (set-buffer (process-buffer bbb-process))
+ (bbb-send-command bbb-process
+ (concat "login " grouplens-pseudonym))
+ (if (bbb-read-response bbb-process)
+ (setq grouplens-bbb-token (bbb-extract-token-number))
+ (gnus-message 3 "Error: GroupLens login failed")))))
+ (gnus-message 3 "Error: you must set a pseudonym"))
+ grouplens-bbb-token)
+
+(defun bbb-extract-token-number ()
+ (let ((token-pos (search-forward "token=" nil t)))
+ (when (looking-at "[0-9]+")
+ (buffer-substring token-pos (match-end 0)))))
+
+(gnus-add-shutdown 'bbb-logout 'gnus)
+
+(defun bbb-logout ()
+ "logout of bbb session"
+ (when grouplens-bbb-token
+ (let ((bbb-process
+ (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
+ (when bbb-process
+ (save-excursion
+ (set-buffer (process-buffer bbb-process))
+ (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token))
+ (bbb-read-response bbb-process))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Get Predictions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun bbb-build-mid-scores-alist (groupname)
+ "this function can be called as part of the function to return the
+list of score files to use. See the gnus variable
+gnus-score-find-score-files-function.
+
+*Note:* If you want to use grouplens scores along with calculated scores,
+you should see the offset and scale variables. At this point, I don't
+recommend using both scores and grouplens predictions together."
+ (setq grouplens-current-group groupname)
+ (when (member groupname grouplens-newsgroups)
+ (setq grouplens-previous-article nil)
+ ;; scores-alist should be a list of lists:
+ ;; ((("message-id" ("<mid1>" score1 nil s) ("<mid2> score2 nil s))))
+ ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value
+ (list
+ (list
+ (list (append (list "message-id")
+ (bbb-get-predictions (bbb-get-all-mids) groupname)))))))
+
+(defun bbb-get-predictions (midlist groupname)
+ "Ask the bbb for predictions, and build up the score alist."
+ (gnus-message 5 "Fetching Predictions...")
+ (if grouplens-bbb-token
+ (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host
+ grouplens-bbb-port)))
+ (when bbb-process
+ (save-excursion
+ (set-buffer (process-buffer bbb-process))
+ (bbb-send-command bbb-process
+ (bbb-build-predict-command midlist groupname
+ grouplens-bbb-token))
+ (if (bbb-read-response bbb-process)
+ (bbb-get-prediction-response bbb-process)
+ (gnus-message 1 "Invalid Token, login and try again")
+ (ding)))))
+ (gnus-message 3 "Error: You are not logged in to a BBB")
+ (ding)))
+
+(defun bbb-get-all-mids ()
+ (mapcar (function (lambda (x) (mail-header-id x))) gnus-newsgroup-headers))
+
+(defun bbb-build-predict-command (mlist grpname token)
+ (concat "getpredictions " token " " grpname "\r\n"
+ (mapconcat 'identity mlist "\r\n") "\r\n.\r\n"))
+
+(defun bbb-get-prediction-response (process)
+ (let ((case-fold-search nil))
+ (goto-char bbb-read-point)
+ (while (and (not (search-forward ".\r\n" nil t))
+ (accept-process-output process bbb-timeout-secs))
+ (goto-char bbb-read-point))
+ (goto-char (+ bbb-response-point 4));; we ought to be right before OK
+ (bbb-build-response-alist)))
+
+;; build-response-alist assumes that the cursor has been positioned at
+;; the first line of the list of mid/rating pairs.
+(defun bbb-build-response-alist ()
+ (let (resp mid pred)
+ (while
+ (cond
+ ((looking-at "\\(<.*>\\) :nopred=")
+ ;;(push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp)
+ (forward-line 1)
+ t)
+ ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)")
+ (setq mid (bbb-get-mid)
+ pred (bbb-get-pred))
+ (push `(,mid ,pred nil s) resp)
+ (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh))
+ grouplens-current-hashtable)
+ (forward-line 1)
+ t)
+ ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)")
+ (setq mid (bbb-get-mid)
+ pred (bbb-get-pred))
+ (push `(,mid ,pred nil s) resp)
+ (gnus-sethash mid (list pred 0 0) grouplens-current-hashtable)
+ (forward-line 1)
+ t)
+ (t nil)))
+ resp))
+
+;; these "get" functions assume that there is an active match lying
+;; around. Where the first parenthesized expression is the
+;; message-id, and the second is the prediction, the third and fourth
+;; are the confidence interval
+;;
+;; Since gnus assumes that scores are integer values?? we round the
+;; prediction.
+(defun bbb-get-mid ()
+ (buffer-substring (match-beginning 1) (match-end 1)))
+
+(defun bbb-get-pred ()
+ (let ((tpred (string-to-number (buffer-substring (match-beginning 2)
+ (match-end 2)))))
+ (if (> tpred 0)
+ (round (* grouplens-score-scale-factor
+ (+ grouplens-score-offset tpred)))
+ 1)))
+
+(defun bbb-get-confl ()
+ (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
+
+(defun bbb-get-confh ()
+ (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Prediction Display
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defconst grplens-rating-range 4.0)
+(defconst grplens-maxrating 5)
+(defconst grplens-minrating 1)
+(defconst grplens-predstringsize 12)
+
+(defvar gnus-tmp-score)
+(defun bbb-grouplens-score (header)
+ (if (eq gnus-grouplens-override-scoring 'separate)
+ (bbb-grouplens-other-score header)
+ (let* ((rate-string (make-string 12 ?\ ))
+ (mid (mail-header-id header))
+ (hashent (gnus-gethash mid grouplens-current-hashtable))
+ (iscore gnus-tmp-score)
+ (low (car (cdr hashent)))
+ (high (car (cdr (cdr hashent)))))
+ (aset rate-string 0 ?|)
+ (aset rate-string 11 ?|)
+ (unless (member grouplens-current-group grouplens-newsgroups)
+ (unless (equal grouplens-prediction-display 'prediction-num)
+ (cond ((< iscore 0)
+ (setq iscore 1))
+ ((> iscore 5)
+ (setq iscore 5))))
+ (setq low 0)
+ (setq high 0))
+ (if (and (bbb-valid-score iscore)
+ (not (null mid)))
+ (cond
+ ;; prediction-spot
+ ((equal grouplens-prediction-display 'prediction-spot)
+ (setq rate-string (bbb-fmt-prediction-spot rate-string iscore)))
+ ;; confidence-interval
+ ((equal grouplens-prediction-display 'confidence-interval)
+ (setq rate-string (bbb-fmt-confidence-interval iscore low high)))
+ ;; prediction-bar
+ ((equal grouplens-prediction-display 'prediction-bar)
+ (setq rate-string (bbb-fmt-prediction-bar rate-string iscore)))
+ ;; confidence-bar
+ ((equal grouplens-prediction-display 'confidence-bar)
+ (setq rate-string (format "| %4.2f |" iscore)))
+ ;; confidence-spot
+ ((equal grouplens-prediction-display 'confidence-spot)
+ (setq rate-string (format "| %4.2f |" iscore)))
+ ;; prediction-num
+ ((equal grouplens-prediction-display 'prediction-num)
+ (setq rate-string (bbb-fmt-prediction-num iscore)))
+ ;; confidence-plus-minus
+ ((equal grouplens-prediction-display 'confidence-plus-minus)
+ (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high))
+ )
+ (t (gnus-message 3 "Invalid prediction display type")))
+ (aset rate-string 5 ?N) (aset rate-string 6 ?A))
+ rate-string)))
+
+;; Gnus user format function that doesn't depend on
+;; bbb-build-mid-scores-alist being used as the score function, but is
+;; instead called from gnus-select-group-hook. -- LAB
+(defun bbb-grouplens-other-score (header)
+ (if (not (member grouplens-current-group grouplens-newsgroups))
+ ;; Return an empty string
+ ""
+ (let* ((rate-string (make-string 12 ?\ ))
+ (mid (mail-header-id header))
+ (hashent (gnus-gethash mid grouplens-current-hashtable))
+ (pred (or (nth 0 hashent) 0))
+ (low (nth 1 hashent))
+ (high (nth 2 hashent)))
+ ;; Init rate-string
+ (aset rate-string 0 ?|)
+ (aset rate-string 11 ?|)
+ (unless (equal grouplens-prediction-display 'prediction-num)
+ (cond ((< pred 0)
+ (setq pred 1))
+ ((> pred 5)
+ (setq pred 5))))
+ ;; If no entry in BBB hash mark rate string as NA and return
+ (cond
+ ((null hashent)
+ (aset rate-string 5 ?N)
+ (aset rate-string 6 ?A)
+ rate-string)
+
+ ((equal grouplens-prediction-display 'prediction-spot)
+ (bbb-fmt-prediction-spot rate-string pred))
+
+ ((equal grouplens-prediction-display 'confidence-interval)
+ (bbb-fmt-confidence-interval pred low high))
+
+ ((equal grouplens-prediction-display 'prediction-bar)
+ (bbb-fmt-prediction-bar rate-string pred))
+
+ ((equal grouplens-prediction-display 'confidence-bar)
+ (format "| %4.2f |" pred))
+
+ ((equal grouplens-prediction-display 'confidence-spot)
+ (format "| %4.2f |" pred))
+
+ ((equal grouplens-prediction-display 'prediction-num)
+ (bbb-fmt-prediction-num pred))
+
+ ((equal grouplens-prediction-display 'confidence-plus-minus)
+ (bbb-fmt-confidence-plus-minus pred low high))
+
+ (t
+ (gnus-message 3 "Invalid prediction display type")
+ (aset rate-string 0 ?|)
+ (aset rate-string 11 ?|)
+ rate-string)))))
+
+(defun bbb-valid-score (score)
+ (or (equal grouplens-prediction-display 'prediction-num)
+ (and (>= score grplens-minrating)
+ (<= score grplens-maxrating))))
+
+(defun bbb-requires-confidence (format-type)
+ (or (equal format-type 'confidence-plus-minus)
+ (equal format-type 'confidence-spot)
+ (equal format-type 'confidence-interval)))
+
+(defun bbb-have-confidence (clow chigh)
+ (not (or (null clow)
+ (null chigh))))
+
+(defun bbb-fmt-prediction-spot (rate-string score)
+ (aset rate-string
+ (round (* (/ (- score grplens-minrating) grplens-rating-range)
+ (+ (- grplens-predstringsize 4) 1.49)))
+ ?*)
+ rate-string)
+
+(defun bbb-fmt-confidence-interval (score low high)
+ (if (bbb-have-confidence low high)
+ (format "|%4.2f-%4.2f |" low high)
+ (bbb-fmt-prediction-num score)))
+
+(defun bbb-fmt-confidence-plus-minus (score low high)
+ (if (bbb-have-confidence low high)
+ (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0))
+ (bbb-fmt-prediction-num score)))
+
+(defun bbb-fmt-prediction-bar (rate-string score)
+ (let* ((i 1)
+ (step (/ grplens-rating-range (- grplens-predstringsize 4)))
+ (half-step (/ step 2))
+ (loc (- grplens-minrating half-step)))
+ (while (< i (- grplens-predstringsize 2))
+ (if (> score loc)
+ (aset rate-string i ?#)
+ (aset rate-string i ?\ ))
+ (setq i (+ i 1))
+ (setq loc (+ loc step)))
+ )
+ rate-string)
+
+(defun bbb-fmt-prediction-num (score)
+ (format "| %4.2f |" score))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Put Ratings
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun bbb-put-ratings ()
+ (if (and grouplens-bbb-token
+ grouplens-rating-alist
+ (member gnus-newsgroup-name grouplens-newsgroups))
+ (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host
+ grouplens-bbb-port))
+ (rate-command (bbb-build-rate-command grouplens-rating-alist)))
+ (if bbb-process
+ (save-excursion
+ (set-buffer (process-buffer bbb-process))
+ (gnus-message 5 "Sending Ratings...")
+ (bbb-send-command bbb-process rate-command)
+ (if (bbb-read-response bbb-process)
+ (setq grouplens-rating-alist nil)
+ (gnus-message 1
+ "Token timed out: call bbb-login and quit again")
+ (ding))
+ (gnus-message 5 "Sending Ratings...Done"))
+ (gnus-message 3 "No BBB connection")))
+ (setq grouplens-rating-alist nil)))
+
+(defun bbb-build-rate-command (rate-alist)
+ (concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n"
+ (mapconcat '(lambda (this) ; form (mid . (score . time))
+ (concat (car this)
+ " :rating=" (cadr this) ".00"
+ " :time=" (cddr this)))
+ rate-alist "\r\n")
+ "\r\n.\r\n"))
+
+;; Interactive rating functions.
+(defun bbb-summary-rate-article (rating &optional midin)
+ (interactive "nRating: ")
+ (when (member gnus-newsgroup-name grouplens-newsgroups)
+ (let ((mid (or midin (bbb-get-current-id))))
+ (if (and rating
+ (>= rating grplens-minrating)
+ (<= rating grplens-maxrating)
+ mid)
+ (let ((oldrating (assoc mid grouplens-rating-alist)))
+ (if oldrating
+ (setcdr oldrating (cons rating 0))
+ (push `(,mid . (,rating . 0)) grouplens-rating-alist))
+ (gnus-summary-mark-article nil (int-to-string rating)))
+ (gnus-message 3 "Invalid rating")))))
+
+(defun grouplens-next-unread-article (rating)
+ "Select unread article after current one."
+ (interactive "P")
+ (when rating
+ (bbb-summary-rate-article rating))
+ (gnus-summary-next-unread-article))
+
+(defun grouplens-best-unread-article (rating)
+ "Select unread article after current one."
+ (interactive "P")
+ (when rating
+ (bbb-summary-rate-article rating))
+ (gnus-summary-best-unread-article))
+
+(defun grouplens-summary-catchup-and-exit (rating)
+ "Mark all articles not marked as unread in this newsgroup as read,
+ then exit. If prefix argument ALL is non-nil, all articles are
+ marked as read."
+ (interactive "P")
+ (when rating
+ (bbb-summary-rate-article rating))
+ (if (numberp rating)
+ (gnus-summary-catchup-and-exit)
+ (gnus-summary-catchup-and-exit rating)))
+
+(defun grouplens-score-thread (score)
+ "Raise the score of the articles in the current thread with SCORE."
+ (interactive "nRating: ")
+ (let (e)
+ (save-excursion
+ (let ((articles (gnus-summary-articles-in-thread))
+ article)
+ (while (setq article (pop articles))
+ (gnus-summary-goto-subject article)
+ (gnus-set-global-variables)
+ (bbb-summary-rate-article score
+ (mail-header-id
+ (gnus-summary-article-header article)))))
+ (setq e (point)))
+ (let ((gnus-summary-check-current t))
+ (or (zerop (gnus-summary-next-subject 1 t))
+ (goto-char e))))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary))
+
+(defun bbb-exit-group ()
+ (bbb-put-ratings)
+ (bbb-renew-hash-table))
+
+(defun bbb-get-current-id ()
+ (if gnus-current-headers
+ (mail-header-id gnus-current-headers)
+ (gnus-message 3 "You must select an article before you rate it")))
+
+(defun bbb-grouplens-group-p (group)
+ "Say whether GROUP is a GroupLens group."
+ (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" ""))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TIME SPENT READING
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar grouplens-current-starting-time nil)
+
+(defun grouplens-start-timer ()
+ (setq grouplens-current-starting-time (current-time)))
+
+(defun grouplens-elapsed-time ()
+ (let ((et (bbb-time-float (current-time))))
+ (- et (bbb-time-float grouplens-current-starting-time))))
+
+(defun bbb-time-float (timeval)
+ (+ (* (car timeval) 65536)
+ (cadr timeval)))
+
+(defun grouplens-do-time ()
+ (when (member gnus-newsgroup-name grouplens-newsgroups)
+ (when grouplens-previous-article
+ (let ((elapsed-time (grouplens-elapsed-time))
+ (oldrating (assoc grouplens-previous-article
+ grouplens-rating-alist)))
+ (if (not oldrating)
+ (push `(,grouplens-previous-article . (0 . ,elapsed-time))
+ grouplens-rating-alist)
+ (setcdr oldrating (cons (cadr oldrating) elapsed-time)))))
+ (grouplens-start-timer)
+ (setq grouplens-previous-article (bbb-get-current-id))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BUG REPORTING
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst gnus-gl-version "gnus-gl.el 2.50")
+(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu")
+(defun gnus-gl-submit-bug-report ()
+ "Submit via mail a bug report on gnus-gl"
+ (interactive)
+ (require 'reporter)
+ (reporter-submit-bug-report gnus-gl-maintainer-address
+ (concat "gnus-gl.el " gnus-gl-version)
+ (list 'grouplens-pseudonym
+ 'grouplens-bbb-host
+ 'grouplens-bbb-port
+ 'grouplens-newsgroups
+ 'grouplens-bbb-token
+ 'grouplens-bbb-process
+ 'grouplens-current-group
+ 'grouplens-previous-article)
+ nil
+ 'gnus-gl-get-trace))
+
+(defun gnus-gl-get-trace ()
+ "Insert the contents of the BBBD trace buffer"
+ (when grouplens-bbb-buffer
+ (insert-buffer grouplens-bbb-buffer)))
+
+;;
+;; GroupLens minor mode
+;;
+
+(defvar gnus-grouplens-mode nil
+ "Minor mode for providing a GroupLens interface in Gnus summary buffers.")
+
+(defvar gnus-grouplens-mode-map nil)
+
+(unless gnus-grouplens-mode-map
+ (setq gnus-grouplens-mode-map (make-keymap))
+ (gnus-define-keys
+ gnus-grouplens-mode-map
+ "n" grouplens-next-unread-article
+ "r" bbb-summary-rate-article
+ "k" grouplens-score-thread
+ "c" grouplens-summary-catchup-and-exit
+ "," grouplens-best-unread-article))
+
+(defun gnus-grouplens-make-menu-bar ()
+ (unless (boundp 'gnus-grouplens-menu)
+ (easy-menu-define
+ gnus-grouplens-menu gnus-grouplens-mode-map ""
+ '("GroupLens"
+ ["Login" bbb-login t]
+ ["Rate" bbb-summary-rate-article t]
+ ["Next article" grouplens-next-unread-article t]
+ ["Best article" grouplens-best-unread-article t]
+ ["Raise thread" grouplens-score-thread t]
+ ["Report bugs" gnus-gl-submit-bug-report t]))))
+
+(defun gnus-grouplens-mode (&optional arg)
+ "Minor mode for providing a GroupLens interface in Gnus summary buffers."
+ (interactive "P")
+ (when (and (eq major-mode 'gnus-summary-mode)
+ (member gnus-newsgroup-name grouplens-newsgroups))
+ (make-local-variable 'gnus-grouplens-mode)
+ (setq gnus-grouplens-mode
+ (if (null arg) (not gnus-grouplens-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (when gnus-grouplens-mode
+ (make-local-hook 'gnus-select-article-hook)
+ (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local)
+ (make-local-hook 'gnus-exit-group-hook)
+ (add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local)
+ (make-local-variable 'gnus-score-find-score-files-function)
+
+ (cond
+ ((eq gnus-grouplens-override-scoring 'combine)
+ ;; either add bbb-buld-mid-scores-alist to a list
+ ;; or make a list
+ (if (listp gnus-score-find-score-files-function)
+ (setq gnus-score-find-score-files-function
+ (append 'bbb-build-mid-scores-alist
+ gnus-score-find-score-files-function))
+ (setq gnus-score-find-score-files-function
+ (list gnus-score-find-score-files-function
+ 'bbb-build-mid-scores-alist))))
+ ;; leave the gnus-score-find-score-files variable alone
+ ((eq gnus-grouplens-override-scoring 'separate)
+ (add-hook 'gnus-select-group-hook
+ (lambda ()
+ (bbb-get-predictions (bbb-get-all-mids)
+ gnus-newsgroup-name))))
+ ;; default is to override
+ (t
+ (setq gnus-score-find-score-files-function
+ 'bbb-build-mid-scores-alist)))
+
+ ;; Change how summary lines look
+ (make-local-variable 'gnus-summary-line-format)
+ (make-local-variable 'gnus-summary-line-format-spec)
+ (setq gnus-summary-line-format gnus-summary-grouplens-line-format)
+ (setq gnus-summary-line-format-spec nil)
+ (gnus-update-format-specifications nil 'summary)
+ (gnus-update-summary-mark-positions)
+
+ ;; Set up the menu.
+ (when (and menu-bar-mode
+ (gnus-visual-p 'grouplens-menu 'menu))
+ (gnus-grouplens-make-menu-bar))
+ (gnus-add-minor-mode
+ 'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map)
+ (run-hooks 'gnus-grouplens-mode-hook))))
+
+(provide 'gnus-gl)
+
+;;; gnus-gl.el ends here
--- /dev/null
+;;; gnus-group.el --- group mode commands for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-start)
+(require 'nnmail)
+(require 'gnus-spec)
+(require 'gnus-int)
+(require 'gnus-range)
+(require 'gnus-win)
+(require 'gnus-undo)
+
+(defcustom gnus-group-archive-directory
+ "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
+ "*The address of the (ding) archives."
+ :group 'gnus-group-foreign
+ :type 'directory)
+
+(defcustom gnus-group-recent-archive-directory
+ "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
+ "*The address of the most recent (ding) articles."
+ :group 'gnus-group-foreign
+ :type 'directory)
+
+(defcustom gnus-no-groups-message "No news is no news"
+ "*Message displayed by Gnus when no groups are available."
+ :group 'gnus-start
+ :type 'string)
+
+(defcustom gnus-keep-same-level nil
+ "*Non-nil means that the next newsgroup after the current will be on the same level.
+When you type, for instance, `n' after reading the last article in the
+current newsgroup, you will go to the next newsgroup. If this variable
+is nil, the next newsgroup will be the next from the group
+buffer.
+If this variable is non-nil, Gnus will either put you in the
+next newsgroup with the same level, or, if no such newsgroup is
+available, the next newsgroup with the lowest possible level higher
+than the current level.
+If this variable is `best', Gnus will make the next newsgroup the one
+with the best level."
+ :group 'gnus-group-levels
+ :type '(choice (const nil)
+ (const best)
+ (sexp :tag "other" t)))
+
+(defcustom gnus-group-goto-unread t
+ "*If non-nil, movement commands will go to the next unread and subscribed group."
+ :link '(custom-manual "(gnus)Group Maneuvering")
+ :group 'gnus-group-various
+ :type 'boolean)
+
+(defcustom gnus-goto-next-group-when-activating t
+ "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group."
+ :link '(custom-manual "(gnus)Scanning New Messages")
+ :group 'gnus-group-various
+ :type 'boolean)
+
+(defcustom gnus-permanently-visible-groups nil
+ "*Regexp to match groups that should always be listed in the group buffer.
+This means that they will still be listed even when there are no
+unread articles in the groups.
+
+If nil, no groups are permanently visible."
+ :group 'gnus-group-listing
+ :type '(choice regexp (const nil)))
+
+(defcustom gnus-list-groups-with-ticked-articles t
+ "*If non-nil, list groups that have only ticked articles.
+If nil, only list groups that have unread articles."
+ :group 'gnus-group-listing
+ :type 'boolean)
+
+(defcustom gnus-group-default-list-level gnus-level-subscribed
+ "*Default listing level.
+Ignored if `gnus-group-use-permanent-levels' is non-nil."
+ :group 'gnus-group-listing
+ :type 'integer)
+
+(defcustom gnus-group-list-inactive-groups t
+ "*If non-nil, inactive groups will be listed."
+ :group 'gnus-group-listing
+ :group 'gnus-group-levels
+ :type 'boolean)
+
+(defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet
+ "*Function used for sorting the group buffer.
+This function will be called with group info entries as the arguments
+for the groups to be sorted. Pre-made functions include
+`gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
+`gnus-group-sort-by-unread', `gnus-group-sort-by-level',
+`gnus-group-sort-by-score', `gnus-group-sort-by-method', and
+`gnus-group-sort-by-rank'.
+
+This variable can also be a list of sorting functions. In that case,
+the most significant sort function should be the last function in the
+list."
+ :group 'gnus-group-listing
+ :link '(custom-manual "(gnus)Sorting Groups")
+ :type '(radio (function-item gnus-group-sort-by-alphabet)
+ (function-item gnus-group-sort-by-real-name)
+ (function-item gnus-group-sort-by-unread)
+ (function-item gnus-group-sort-by-level)
+ (function-item gnus-group-sort-by-score)
+ (function-item gnus-group-sort-by-method)
+ (function-item gnus-group-sort-by-rank)
+ (function :tag "other" nil)))
+
+(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
+ "*Format of group lines.
+It works along the same lines as a normal formatting string,
+with some simple extensions.
+
+%M Only marked articles (character, \"*\" or \" \")
+%S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
+%L Level of subscribedness (integer)
+%N Number of unread articles (integer)
+%I Number of dormant articles (integer)
+%i Number of ticked and dormant (integer)
+%T Number of ticked articles (integer)
+%R Number of read articles (integer)
+%t Estimated total number of articles (integer)
+%y Number of unread, unticked articles (integer)
+%G Group name (string)
+%g Qualified group name (string)
+%D Group description (string)
+%s Select method (string)
+%o Moderated group (char, \"m\")
+%p Process mark (char)
+%O Moderated group (string, \"(m)\" or \"\")
+%P Topic indentation (string)
+%m Whether there is new(ish) mail in the group (char, \"%\")
+%l Whether there are GroupLens predictions for this group (string)
+%n Select from where (string)
+%z A string that look like `<%s:%n>' if a foreign select method is used
+%d The date the group was last entered.
+%u User defined specifier. The next character in the format string should
+ be a letter. Gnus will call the function gnus-user-format-function-X,
+ where X is the letter following %u. The function will be passed the
+ current header as argument. The function should return a string, which
+ will be inserted into the buffer just like information from any other
+ group specifier.
+
+Text between %( and %) will be highlighted with `gnus-mouse-face' when
+the mouse point move inside the area. There can only be one such area.
+
+Note that this format specification is not always respected. For
+reasons of efficiency, when listing killed groups, this specification
+is ignored altogether. If the spec is changed considerably, your
+output may end up looking strange when listing both alive and killed
+groups.
+
+If you use %o or %O, reading the active file will be slower and quite
+a bit of extra memory will be used. %D will also worsen performance.
+Also note that if you change the format specification to include any
+of these specs, you must probably re-start Gnus to see them go into
+effect."
+ :group 'gnus-group-visual
+ :type 'string)
+
+(defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
+ "*The format specification for the group mode line.
+It works along the same lines as a normal formatting string,
+with some simple extensions:
+
+%S The native news server.
+%M The native select method.
+%: \":\" if %S isn't \"\"."
+ :group 'gnus-group-visual
+ :type 'string)
+
+(defcustom gnus-group-mode-hook nil
+ "Hook for Gnus group mode."
+ :group 'gnus-group-various
+ :options '(gnus-topic-mode)
+ :type 'hook)
+
+(defcustom gnus-group-menu-hook nil
+ "Hook run after the creation of the group mode menu."
+ :group 'gnus-group-various
+ :type 'hook)
+
+(defcustom gnus-group-catchup-group-hook nil
+ "Hook run when catching up a group from the group buffer."
+ :group 'gnus-group-various
+ :link '(custom-manual "(gnus)Group Data")
+ :type 'hook)
+
+(defcustom gnus-group-update-group-hook nil
+ "Hook called when updating group lines."
+ :group 'gnus-group-visual
+ :type 'hook)
+
+(defcustom gnus-group-prepare-function 'gnus-group-prepare-flat
+ "*A function that is called to generate the group buffer.
+The function is called with three arguments: The first is a number;
+all group with a level less or equal to that number should be listed,
+if the second is non-nil, empty groups should also be displayed. If
+the third is non-nil, it is a number. No groups with a level lower
+than this number should be displayed.
+
+The only current function implemented is `gnus-group-prepare-flat'."
+ :group 'gnus-group-listing
+ :type 'function)
+
+(defcustom gnus-group-prepare-hook nil
+ "Hook called after the group buffer has been generated.
+If you want to modify the group buffer, you can use this hook."
+ :group 'gnus-group-listing
+ :type 'hook)
+
+(defcustom gnus-suspend-gnus-hook nil
+ "Hook called when suspending (not exiting) Gnus."
+ :group 'gnus-exit
+ :type 'hook)
+
+(defcustom gnus-exit-gnus-hook nil
+ "Hook called when exiting Gnus."
+ :group 'gnus-exit
+ :type 'hook)
+
+(defcustom gnus-after-exiting-gnus-hook nil
+ "Hook called after exiting Gnus."
+ :group 'gnus-exit
+ :type 'hook)
+
+(defcustom gnus-group-update-hook '(gnus-group-highlight-line)
+ "Hook called when a group line is changed.
+The hook will not be called if `gnus-visual' is nil.
+
+The default function `gnus-group-highlight-line' will
+highlight the line according to the `gnus-group-highlight'
+variable."
+ :group 'gnus-group-visual
+ :type 'hook)
+
+(defcustom gnus-useful-groups
+ `(("(ding) mailing list mirrored at sunsite.auc.dk"
+ "emacs.ding"
+ (nntp "sunsite.auc.dk"
+ (nntp-address "sunsite.auc.dk")))
+ ("Gnus help group"
+ "gnus-help"
+ (nndoc "gnus-help"
+ (nndoc-article-type mbox)
+ (eval `(nndoc-address
+ ,(let ((file (nnheader-find-etc-directory
+ "gnus-tut.txt" t)))
+ (unless file
+ (error "Couldn't find doc group"))
+ file))))))
+ "Alist of useful group-server pairs."
+ :group 'gnus-group-listing
+ :type '(repeat (list (string :tag "Description")
+ (string :tag "Name")
+ (sexp :tag "Method"))))
+
+(defcustom gnus-group-highlight
+ '(;; News.
+ ((and (= unread 0) (not mailp) (eq level 1)) .
+ gnus-group-news-1-empty-face)
+ ((and (not mailp) (eq level 1)) .
+ gnus-group-news-1-face)
+ ((and (= unread 0) (not mailp) (eq level 2)) .
+ gnus-group-news-2-empty-face)
+ ((and (not mailp) (eq level 2)) .
+ gnus-group-news-2-face)
+ ((and (= unread 0) (not mailp) (eq level 3)) .
+ gnus-group-news-3-empty-face)
+ ((and (not mailp) (eq level 3)) .
+ gnus-group-news-3-face)
+ ((and (= unread 0) (not mailp)) .
+ gnus-group-news-low-empty-face)
+ ((and (not mailp)) .
+ gnus-group-news-low-face)
+ ;; Mail.
+ ((and (= unread 0) (eq level 1)) .
+ gnus-group-mail-1-empty-face)
+ ((eq level 1) .
+ gnus-group-mail-1-face)
+ ((and (= unread 0) (eq level 2)) .
+ gnus-group-mail-2-empty-face)
+ ((eq level 2) .
+ gnus-group-mail-2-face)
+ ((and (= unread 0) (eq level 3)) .
+ gnus-group-mail-3-empty-face)
+ ((eq level 3) .
+ gnus-group-mail-3-face)
+ ((= unread 0) .
+ gnus-group-mail-low-empty-face)
+ (t .
+ gnus-group-mail-low-face))
+ "Controls the highlighting of group buffer lines.
+
+Below is a list of `Form'/`Face' pairs. When deciding how a a
+particular group line should be displayed, each form is
+evaluated. The content of the face field after the first true form is
+used. You can change how those group lines are displayed by
+editing the face field.
+
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions. Hopefully this will
+change in a future release. For now, you can use the following
+variables in the Lisp expression:
+
+group: The name of the group.
+unread: The number of unread articles in the group.
+method: The select method used.
+mailp: Whether it's a mail group or not.
+level: The level of the group.
+score: The score of the group.
+ticked: The number of ticked articles."
+ :group 'gnus-group-visual
+ :type '(repeat (cons (sexp :tag "Form") face)))
+
+(defcustom gnus-new-mail-mark ?%
+ "Mark used for groups with new mail."
+ :group 'gnus-group-visual
+ :type 'character)
+
+;;; Internal variables
+
+(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
+ "Function for sorting the group buffer.")
+
+(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
+ "Function for sorting the selected groups in the group buffer.")
+
+(defvar gnus-group-indentation-function nil)
+(defvar gnus-goto-missing-group-function nil)
+(defvar gnus-group-update-group-function nil)
+(defvar gnus-group-goto-next-group-function nil
+ "Function to override finding the next group after listing groups.")
+
+(defvar gnus-group-edit-buffer nil)
+
+(defvar gnus-group-line-format-alist
+ `((?M gnus-tmp-marked-mark ?c)
+ (?S gnus-tmp-subscribed ?c)
+ (?L gnus-tmp-level ?d)
+ (?N (cond ((eq number t) "*" )
+ ((numberp number)
+ (int-to-string
+ (+ number
+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
+ (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
+ (t number)) ?s)
+ (?R gnus-tmp-number-of-read ?s)
+ (?t gnus-tmp-number-total ?d)
+ (?y gnus-tmp-number-of-unread ?s)
+ (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
+ (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
+ (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
+ (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
+ (?g gnus-tmp-group ?s)
+ (?G gnus-tmp-qualified-group ?s)
+ (?c (gnus-short-group-name gnus-tmp-group) ?s)
+ (?D gnus-tmp-newsgroup-description ?s)
+ (?o gnus-tmp-moderated ?c)
+ (?O gnus-tmp-moderated-string ?s)
+ (?p gnus-tmp-process-marked ?c)
+ (?s gnus-tmp-news-server ?s)
+ (?n gnus-tmp-news-method ?s)
+ (?P gnus-group-indentation ?s)
+ (?l gnus-tmp-grouplens ?s)
+ (?z gnus-tmp-news-method-string ?s)
+ (?m (gnus-group-new-mail gnus-tmp-group) ?c)
+ (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
+ (?u gnus-tmp-user-defined ?s)))
+
+(defvar gnus-group-mode-line-format-alist
+ `((?S gnus-tmp-news-server ?s)
+ (?M gnus-tmp-news-method ?s)
+ (?u gnus-tmp-user-defined ?s)
+ (?: gnus-tmp-colon ?s)))
+
+(defvar gnus-topic-topology nil
+ "The complete topic hierarchy.")
+
+(defvar gnus-topic-alist nil
+ "The complete topic-group alist.")
+
+(defvar gnus-group-marked nil)
+
+(defvar gnus-group-list-mode nil)
+
+;;;
+;;; Gnus group mode
+;;;
+
+(put 'gnus-group-mode 'mode-class 'special)
+
+(when t
+ (gnus-define-keys gnus-group-mode-map
+ " " gnus-group-read-group
+ "=" gnus-group-select-group
+ "\r" gnus-group-select-group
+ "\M-\r" gnus-group-quick-select-group
+ [(meta control return)] gnus-group-select-group-ephemerally
+ "j" gnus-group-jump-to-group
+ "n" gnus-group-next-unread-group
+ "p" gnus-group-prev-unread-group
+ "\177" gnus-group-prev-unread-group
+ [delete] gnus-group-prev-unread-group
+ "N" gnus-group-next-group
+ "P" gnus-group-prev-group
+ "\M-n" gnus-group-next-unread-group-same-level
+ "\M-p" gnus-group-prev-unread-group-same-level
+ "," gnus-group-best-unread-group
+ "." gnus-group-first-unread-group
+ "u" gnus-group-unsubscribe-current-group
+ "U" gnus-group-unsubscribe-group
+ "c" gnus-group-catchup-current
+ "C" gnus-group-catchup-current-all
+ "\M-c" gnus-group-clear-data
+ "l" gnus-group-list-groups
+ "L" gnus-group-list-all-groups
+ "m" gnus-group-mail
+ "g" gnus-group-get-new-news
+ "\M-g" gnus-group-get-new-news-this-group
+ "R" gnus-group-restart
+ "r" gnus-group-read-init-file
+ "B" gnus-group-browse-foreign-server
+ "b" gnus-group-check-bogus-groups
+ "F" gnus-group-find-new-groups
+ "\C-c\C-d" gnus-group-describe-group
+ "\M-d" gnus-group-describe-all-groups
+ "\C-c\C-a" gnus-group-apropos
+ "\C-c\M-\C-a" gnus-group-description-apropos
+ "a" gnus-group-post-news
+ "\ek" gnus-group-edit-local-kill
+ "\eK" gnus-group-edit-global-kill
+ "\C-k" gnus-group-kill-group
+ "\C-y" gnus-group-yank-group
+ "\C-w" gnus-group-kill-region
+ "\C-x\C-t" gnus-group-transpose-groups
+ "\C-c\C-l" gnus-group-list-killed
+ "\C-c\C-x" gnus-group-expire-articles
+ "\C-c\M-\C-x" gnus-group-expire-all-groups
+ "V" gnus-version
+ "s" gnus-group-save-newsrc
+ "z" gnus-group-suspend
+ "q" gnus-group-exit
+ "Q" gnus-group-quit
+ "?" gnus-group-describe-briefly
+ "\C-c\C-i" gnus-info-find-node
+ "\M-e" gnus-group-edit-group-method
+ "^" gnus-group-enter-server-mode
+ gnus-mouse-2 gnus-mouse-pick-group
+ "<" beginning-of-buffer
+ ">" end-of-buffer
+ "\C-c\C-b" gnus-bug
+ "\C-c\C-s" gnus-group-sort-groups
+ "t" gnus-topic-mode
+ "\C-c\M-g" gnus-activate-all-groups
+ "\M-&" gnus-group-universal-argument
+ "#" gnus-group-mark-group
+ "\M-#" gnus-group-unmark-group)
+
+ (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
+ "m" gnus-group-mark-group
+ "u" gnus-group-unmark-group
+ "w" gnus-group-mark-region
+ "b" gnus-group-mark-buffer
+ "r" gnus-group-mark-regexp
+ "U" gnus-group-unmark-all-groups)
+
+ (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
+ "d" gnus-group-make-directory-group
+ "h" gnus-group-make-help-group
+ "u" gnus-group-make-useful-group
+ "a" gnus-group-make-archive-group
+ "k" gnus-group-make-kiboze-group
+ "m" gnus-group-make-group
+ "E" gnus-group-edit-group
+ "e" gnus-group-edit-group-method
+ "p" gnus-group-edit-group-parameters
+ "v" gnus-group-add-to-virtual
+ "V" gnus-group-make-empty-virtual
+ "D" gnus-group-enter-directory
+ "f" gnus-group-make-doc-group
+ "w" gnus-group-make-web-group
+ "r" gnus-group-rename-group
+ "c" gnus-group-customize
+ "\177" gnus-group-delete-group
+ [delete] gnus-group-delete-group)
+
+ (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
+ "b" gnus-group-brew-soup
+ "w" gnus-soup-save-areas
+ "s" gnus-soup-send-replies
+ "p" gnus-soup-pack-packet
+ "r" nnsoup-pack-replies)
+
+ (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
+ "s" gnus-group-sort-groups
+ "a" gnus-group-sort-groups-by-alphabet
+ "u" gnus-group-sort-groups-by-unread
+ "l" gnus-group-sort-groups-by-level
+ "v" gnus-group-sort-groups-by-score
+ "r" gnus-group-sort-groups-by-rank
+ "m" gnus-group-sort-groups-by-method)
+
+ (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
+ "s" gnus-group-sort-selected-groups
+ "a" gnus-group-sort-selected-groups-by-alphabet
+ "u" gnus-group-sort-selected-groups-by-unread
+ "l" gnus-group-sort-selected-groups-by-level
+ "v" gnus-group-sort-selected-groups-by-score
+ "r" gnus-group-sort-selected-groups-by-rank
+ "m" gnus-group-sort-selected-groups-by-method)
+
+ (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
+ "k" gnus-group-list-killed
+ "z" gnus-group-list-zombies
+ "s" gnus-group-list-groups
+ "u" gnus-group-list-all-groups
+ "A" gnus-group-list-active
+ "a" gnus-group-apropos
+ "d" gnus-group-description-apropos
+ "m" gnus-group-list-matching
+ "M" gnus-group-list-all-matching
+ "l" gnus-group-list-level)
+
+ (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
+ "f" gnus-score-flush-cache)
+
+ (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
+ "d" gnus-group-describe-group
+ "f" gnus-group-fetch-faq
+ "v" gnus-version)
+
+ (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
+ "l" gnus-group-set-current-level
+ "t" gnus-group-unsubscribe-current-group
+ "s" gnus-group-unsubscribe-group
+ "k" gnus-group-kill-group
+ "y" gnus-group-yank-group
+ "w" gnus-group-kill-region
+ "\C-k" gnus-group-kill-level
+ "z" gnus-group-kill-all-zombies))
+
+(defun gnus-group-make-menu-bar ()
+ (gnus-turn-off-edit-menu 'group)
+ (unless (boundp 'gnus-group-reading-menu)
+
+ (easy-menu-define
+ gnus-group-reading-menu gnus-group-mode-map ""
+ '("Group"
+ ["Read" gnus-group-read-group (gnus-group-group-name)]
+ ["Select" gnus-group-select-group (gnus-group-group-name)]
+ ["See old articles" (gnus-group-select-group 'all)
+ :keys "C-u SPC" :active (gnus-group-group-name)]
+ ["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
+ ["Catch up all articles" gnus-group-catchup-current-all
+ (gnus-group-group-name)]
+ ["Check for new articles" gnus-group-get-new-news-this-group
+ (gnus-group-group-name)]
+ ["Toggle subscription" gnus-group-unsubscribe-current-group
+ (gnus-group-group-name)]
+ ["Kill" gnus-group-kill-group (gnus-group-group-name)]
+ ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
+ ["Describe" gnus-group-describe-group (gnus-group-group-name)]
+ ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
+ ;; Actually one should check, if any of the marked groups gives t for
+ ;; (gnus-check-backend-function 'request-expire-articles ...)
+ ["Expire articles" gnus-group-expire-articles
+ (or (and (gnus-group-group-name)
+ (gnus-check-backend-function
+ 'request-expire-articles
+ (gnus-group-group-name))) gnus-group-marked)]
+ ["Set group level" gnus-group-set-current-level
+ (gnus-group-group-name)]
+ ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
+ ["Customize" gnus-group-customize (gnus-group-group-name)]
+ ("Edit"
+ ["Parameters" gnus-group-edit-group-parameters
+ (gnus-group-group-name)]
+ ["Select method" gnus-group-edit-group-method
+ (gnus-group-group-name)]
+ ["Info" gnus-group-edit-group (gnus-group-group-name)]
+ ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
+ ["Global kill file" gnus-group-edit-global-kill t])))
+
+ (easy-menu-define
+ gnus-group-group-menu gnus-group-mode-map ""
+ '("Groups"
+ ("Listing"
+ ["List unread subscribed groups" gnus-group-list-groups t]
+ ["List (un)subscribed groups" gnus-group-list-all-groups t]
+ ["List killed groups" gnus-group-list-killed gnus-killed-list]
+ ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
+ ["List level..." gnus-group-list-level t]
+ ["Describe all groups" gnus-group-describe-all-groups t]
+ ["Group apropos..." gnus-group-apropos t]
+ ["Group and description apropos..." gnus-group-description-apropos t]
+ ["List groups matching..." gnus-group-list-matching t]
+ ["List all groups matching..." gnus-group-list-all-matching t]
+ ["List active file" gnus-group-list-active t])
+ ("Sort"
+ ["Default sort" gnus-group-sort-groups t]
+ ["Sort by method" gnus-group-sort-groups-by-method t]
+ ["Sort by rank" gnus-group-sort-groups-by-rank t]
+ ["Sort by score" gnus-group-sort-groups-by-score t]
+ ["Sort by level" gnus-group-sort-groups-by-level t]
+ ["Sort by unread" gnus-group-sort-groups-by-unread t]
+ ["Sort by name" gnus-group-sort-groups-by-alphabet t])
+ ("Sort process/prefixed"
+ ["Default sort" gnus-group-sort-selected-groups
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by method" gnus-group-sort-selected-groups-by-method
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by rank" gnus-group-sort-selected-groups-by-rank
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by score" gnus-group-sort-selected-groups-by-score
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by level" gnus-group-sort-selected-groups-by-level
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by unread" gnus-group-sort-selected-groups-by-unread
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
+ ("Mark"
+ ["Mark group" gnus-group-mark-group
+ (and (gnus-group-group-name)
+ (not (memq (gnus-group-group-name) gnus-group-marked)))]
+ ["Unmark group" gnus-group-unmark-group
+ (and (gnus-group-group-name)
+ (memq (gnus-group-group-name) gnus-group-marked))]
+ ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
+ ["Mark regexp..." gnus-group-mark-regexp t]
+ ["Mark region" gnus-group-mark-region t]
+ ["Mark buffer" gnus-group-mark-buffer t]
+ ["Execute command" gnus-group-universal-argument
+ (or gnus-group-marked (gnus-group-group-name))])
+ ("Subscribe"
+ ["Subscribe to a group" gnus-group-unsubscribe-group t]
+ ["Kill all newsgroups in region" gnus-group-kill-region t]
+ ["Kill all zombie groups" gnus-group-kill-all-zombies
+ gnus-zombie-list]
+ ["Kill all groups on level..." gnus-group-kill-level t])
+ ("Foreign groups"
+ ["Make a foreign group" gnus-group-make-group t]
+ ["Add a directory group" gnus-group-make-directory-group t]
+ ["Add the help group" gnus-group-make-help-group t]
+ ["Add the archive group" gnus-group-make-archive-group t]
+ ["Make a doc group" gnus-group-make-doc-group t]
+ ["Make a web group" gnus-group-make-web-group t]
+ ["Make a kiboze group" gnus-group-make-kiboze-group t]
+ ["Make a virtual group" gnus-group-make-empty-virtual t]
+ ["Add a group to a virtual" gnus-group-add-to-virtual t]
+ ["Rename group" gnus-group-rename-group
+ (gnus-check-backend-function
+ 'request-rename-group (gnus-group-group-name))]
+ ["Delete group" gnus-group-delete-group
+ (gnus-check-backend-function
+ 'request-delete-group (gnus-group-group-name))])
+ ("Move"
+ ["Next" gnus-group-next-group t]
+ ["Previous" gnus-group-prev-group t]
+ ["Next unread" gnus-group-next-unread-group t]
+ ["Previous unread" gnus-group-prev-unread-group t]
+ ["Next unread same level" gnus-group-next-unread-group-same-level t]
+ ["Previous unread same level"
+ gnus-group-prev-unread-group-same-level t]
+ ["Jump to group" gnus-group-jump-to-group t]
+ ["First unread group" gnus-group-first-unread-group t]
+ ["Best unread group" gnus-group-best-unread-group t])
+ ["Delete bogus groups" gnus-group-check-bogus-groups t]
+ ["Find new newsgroups" gnus-group-find-new-groups t]
+ ["Transpose" gnus-group-transpose-groups
+ (gnus-group-group-name)]
+ ["Read a directory as a group..." gnus-group-enter-directory t]))
+
+ (easy-menu-define
+ gnus-group-misc-menu gnus-group-mode-map ""
+ '("Misc"
+ ("SOUP"
+ ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
+ ["Send replies" gnus-soup-send-replies
+ (fboundp 'gnus-soup-pack-packet)]
+ ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
+ ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
+ ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
+ ["Send a bug report" gnus-bug t]
+ ["Send a mail" gnus-group-mail t]
+ ["Post an article..." gnus-group-post-news t]
+ ["Check for new news" gnus-group-get-new-news t]
+ ["Activate all groups" gnus-activate-all-groups t]
+ ["Restart Gnus" gnus-group-restart t]
+ ["Read init file" gnus-group-read-init-file t]
+ ["Browse foreign server" gnus-group-browse-foreign-server t]
+ ["Enter server buffer" gnus-group-enter-server-mode t]
+ ["Expire all expirable articles" gnus-group-expire-all-groups t]
+ ["Generate any kiboze groups" nnkiboze-generate-groups t]
+ ["Gnus version" gnus-version t]
+ ["Save .newsrc files" gnus-group-save-newsrc t]
+ ["Suspend Gnus" gnus-group-suspend t]
+ ["Clear dribble buffer" gnus-group-clear-dribble t]
+ ["Read manual" gnus-info-find-node t]
+ ["Flush score cache" gnus-score-flush-cache t]
+ ["Toggle topics" gnus-topic-mode t]
+ ["Exit from Gnus" gnus-group-exit t]
+ ["Exit without saving" gnus-group-quit t]))
+
+ (run-hooks 'gnus-group-menu-hook)))
+
+(defun gnus-group-mode ()
+ "Major mode for reading news.
+
+All normal editing commands are switched off.
+\\<gnus-group-mode-map>
+The group buffer lists (some of) the groups available. For instance,
+`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
+lists all zombie groups.
+
+Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe
+to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
+
+For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
+
+The following commands are available:
+
+\\{gnus-group-mode-map}"
+ (interactive)
+ (when (gnus-visual-p 'group-menu 'menu)
+ (gnus-group-make-menu-bar))
+ (kill-all-local-variables)
+ (gnus-simplify-mode-line)
+ (setq major-mode 'gnus-group-mode)
+ (setq mode-name "Group")
+ (gnus-group-set-mode-line)
+ (setq mode-line-process nil)
+ (use-local-map gnus-group-mode-map)
+ (buffer-disable-undo (current-buffer))
+ (setq truncate-lines t)
+ (setq buffer-read-only t)
+ (gnus-set-default-directory)
+ (gnus-update-format-specifications nil 'group 'group-mode)
+ (gnus-update-group-mark-positions)
+ (make-local-hook 'post-command-hook)
+ (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
+ (when gnus-use-undo
+ (gnus-undo-mode 1))
+ (run-hooks 'gnus-group-mode-hook))
+
+(defun gnus-update-group-mark-positions ()
+ (save-excursion
+ (let ((gnus-process-mark 128)
+ (gnus-group-marked '("dummy.group"))
+ (gnus-active-hashtb (make-vector 10 0)))
+ (gnus-set-active "dummy.group" '(0 . 0))
+ (gnus-set-work-buffer)
+ (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
+ (goto-char (point-min))
+ (setq gnus-group-mark-positions
+ (list (cons 'process (and (search-forward "\200" nil t)
+ (- (point) 2))))))))
+
+(defun gnus-clear-inboxes-moved ()
+ (setq nnmail-moved-inboxes nil))
+
+(defun gnus-mouse-pick-group (e)
+ "Enter the group under the mouse pointer."
+ (interactive "e")
+ (mouse-set-point e)
+ (gnus-group-read-group nil))
+
+;; Look at LEVEL and find out what the level is really supposed to be.
+;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
+;; will depend on whether `gnus-group-use-permanent-levels' is used.
+(defun gnus-group-default-level (&optional level number-or-nil)
+ (cond
+ (gnus-group-use-permanent-levels
+ (or (setq gnus-group-use-permanent-levels
+ (or level (if (numberp gnus-group-use-permanent-levels)
+ gnus-group-use-permanent-levels
+ (or gnus-group-default-list-level
+ gnus-level-subscribed))))
+ gnus-group-default-list-level gnus-level-subscribed))
+ (number-or-nil
+ level)
+ (t
+ (or level gnus-group-default-list-level gnus-level-subscribed))))
+
+(defun gnus-group-setup-buffer ()
+ (switch-to-buffer (get-buffer-create gnus-group-buffer))
+ (unless (eq major-mode 'gnus-group-mode)
+ (gnus-add-current-to-buffer-list)
+ (gnus-group-mode)
+ (when gnus-carpal
+ (gnus-carpal-setup-buffer 'group))))
+
+(defun gnus-group-list-groups (&optional level unread lowest)
+ "List newsgroups with level LEVEL or lower that have unread articles.
+Default is all subscribed groups.
+If argument UNREAD is non-nil, groups with no unread articles are also
+listed.
+
+Also see the `gnus-group-use-permanent-levels' variable."
+ (interactive
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ (or
+ (gnus-group-default-level nil t)
+ gnus-group-default-list-level
+ gnus-level-subscribed))))
+ ;; Just do this here, for no particular good reason.
+ (gnus-clear-inboxes-moved)
+ (unless level
+ (setq level (car gnus-group-list-mode)
+ unread (cdr gnus-group-list-mode)))
+ (setq level (gnus-group-default-level level))
+ (gnus-group-setup-buffer)
+ (gnus-update-format-specifications nil 'group 'group-mode)
+ (let ((case-fold-search nil)
+ (props (text-properties-at (gnus-point-at-bol)))
+ (empty (= (point-min) (point-max)))
+ (group (gnus-group-group-name))
+ number)
+ (set-buffer gnus-group-buffer)
+ (setq number (funcall gnus-group-prepare-function level unread lowest))
+ (when (or (and (numberp number)
+ (zerop number))
+ (zerop (buffer-size)))
+ ;; No groups in the buffer.
+ (gnus-message 5 gnus-no-groups-message))
+ ;; We have some groups displayed.
+ (goto-char (point-max))
+ (when (or (not gnus-group-goto-next-group-function)
+ (not (funcall gnus-group-goto-next-group-function
+ group props)))
+ (cond
+ (empty
+ (goto-char (point-min)))
+ ((not group)
+ ;; Go to the first group with unread articles.
+ (gnus-group-search-forward t))
+ (t
+ ;; Find the right group to put point on. If the current group
+ ;; has disappeared in the new listing, try to find the next
+ ;; one. If no next one can be found, just leave point at the
+ ;; first newsgroup in the buffer.
+ (when (not (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe
+ group gnus-active-hashtb))))
+ (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
+ (while (and newsrc
+ (not (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max) 'gnus-group
+ (gnus-intern-safe
+ (caar newsrc) gnus-active-hashtb)))))
+ (setq newsrc (cdr newsrc)))
+ (unless newsrc
+ (goto-char (point-max))
+ (forward-line -1)))))))
+ ;; Adjust cursor point.
+ (gnus-group-position-point)))
+
+(defun gnus-group-list-level (level &optional all)
+ "List groups on LEVEL.
+If ALL (the prefix), also list groups that have no unread articles."
+ (interactive "nList groups on level: \nP")
+ (gnus-group-list-groups level all level))
+
+(defun gnus-group-prepare-flat (level &optional all lowest regexp)
+ "List all newsgroups with unread articles of level LEVEL or lower.
+If ALL is non-nil, list groups that have no unread articles.
+If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
+If REGEXP, only list groups matching REGEXP."
+ (set-buffer gnus-group-buffer)
+ (let ((buffer-read-only nil)
+ (newsrc (cdr gnus-newsrc-alist))
+ (lowest (or lowest 1))
+ info clevel unread group params)
+ (erase-buffer)
+ (when (< lowest gnus-level-zombie)
+ ;; List living groups.
+ (while newsrc
+ (setq info (car newsrc)
+ group (gnus-info-group info)
+ params (gnus-info-params info)
+ newsrc (cdr newsrc)
+ unread (car (gnus-gethash group gnus-newsrc-hashtb)))
+ (and unread ; This group might be bogus
+ (or (not regexp)
+ (string-match regexp group))
+ (<= (setq clevel (gnus-info-level info)) level)
+ (>= clevel lowest)
+ (or all ; We list all groups?
+ (if (eq unread t) ; Unactivated?
+ gnus-group-list-inactive-groups ; We list unactivated
+ (> unread 0)) ; We list groups with unread articles
+ (and gnus-list-groups-with-ticked-articles
+ (cdr (assq 'tick (gnus-info-marks info))))
+ ; And groups with tickeds
+ ;; Check for permanent visibility.
+ (and gnus-permanently-visible-groups
+ (string-match gnus-permanently-visible-groups
+ group))
+ (memq 'visible params)
+ (cdr (assq 'visible params)))
+ (gnus-group-insert-group-line
+ group (gnus-info-level info)
+ (gnus-info-marks info) unread (gnus-info-method info)))))
+
+ ;; List dead groups.
+ (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
+ (gnus-group-prepare-flat-list-dead
+ (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+ gnus-level-zombie ?Z
+ regexp))
+ (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
+ (gnus-group-prepare-flat-list-dead
+ (setq gnus-killed-list (sort gnus-killed-list 'string<))
+ gnus-level-killed ?K regexp))
+
+ (gnus-group-set-mode-line)
+ (setq gnus-group-list-mode (cons level all))
+ (run-hooks 'gnus-group-prepare-hook)
+ t))
+
+(defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
+ ;; List zombies and killed lists somewhat faster, which was
+ ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
+ ;; this by ignoring the group format specification altogether.
+ (let (group)
+ (if regexp
+ ;; This loop is used when listing groups that match some
+ ;; regexp.
+ (while groups
+ (setq group (pop groups))
+ (when (string-match regexp group)
+ (gnus-add-text-properties
+ (point) (prog1 (1+ (point))
+ (insert " " mark " *: " group "\n"))
+ (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
+ 'gnus-unread t
+ 'gnus-level level))))
+ ;; This loop is used when listing all groups.
+ (while groups
+ (gnus-add-text-properties
+ (point) (prog1 (1+ (point))
+ (insert " " mark " *: "
+ (setq group (pop groups)) "\n"))
+ (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
+ 'gnus-unread t
+ 'gnus-level level))))))
+
+(defun gnus-group-update-group-line ()
+ "Update the current line in the group buffer."
+ (let* ((buffer-read-only nil)
+ (group (gnus-group-group-name))
+ (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
+ gnus-group-indentation)
+ (when group
+ (and entry
+ (not (gnus-ephemeral-group-p group))
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (nth 2 entry))
+ ")")))
+ (setq gnus-group-indentation (gnus-group-group-indentation))
+ (gnus-delete-line)
+ (gnus-group-insert-group-line-info group)
+ (forward-line -1)
+ (gnus-group-position-point))))
+
+(defun gnus-group-insert-group-line-info (group)
+ "Insert GROUP on the current line."
+ (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ (gnus-group-indentation (gnus-group-group-indentation))
+ active info)
+ (if entry
+ (progn
+ ;; (Un)subscribed group.
+ (setq info (nth 2 entry))
+ (gnus-group-insert-group-line
+ group (gnus-info-level info) (gnus-info-marks info)
+ (or (car entry) t) (gnus-info-method info)))
+ ;; This group is dead.
+ (gnus-group-insert-group-line
+ group
+ (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
+ nil
+ (if (setq active (gnus-active group))
+ (if (zerop (cdr active))
+ 0
+ (- (1+ (cdr active)) (car active)))
+ nil)
+ nil))))
+
+(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
+ gnus-tmp-marked number
+ gnus-tmp-method)
+ "Insert a group line in the group buffer."
+ (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
+ (gnus-tmp-number-total
+ (if gnus-tmp-active
+ (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
+ 0))
+ (gnus-tmp-number-of-unread
+ (if (numberp number) (int-to-string (max 0 number))
+ "*"))
+ (gnus-tmp-number-of-read
+ (if (numberp number)
+ (int-to-string (max 0 (- gnus-tmp-number-total number)))
+ "*"))
+ (gnus-tmp-subscribed
+ (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
+ ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
+ ((= gnus-tmp-level gnus-level-zombie) ?Z)
+ (t ?K)))
+ (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
+ (gnus-tmp-newsgroup-description
+ (if gnus-description-hashtb
+ (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
+ ""))
+ (gnus-tmp-moderated
+ (if (and gnus-moderated-hashtb
+ (gnus-gethash gnus-tmp-group gnus-moderated-hashtb))
+ ?m ? ))
+ (gnus-tmp-moderated-string
+ (if (eq gnus-tmp-moderated ?m) "(m)" ""))
+ (gnus-tmp-method
+ (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ;
+ (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
+ (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
+ (gnus-tmp-news-method-string
+ (if gnus-tmp-method
+ (format "(%s:%s)" (car gnus-tmp-method)
+ (cadr gnus-tmp-method)) ""))
+ (gnus-tmp-marked-mark
+ (if (and (numberp number)
+ (zerop number)
+ (cdr (assq 'tick gnus-tmp-marked)))
+ ?* ? ))
+ (gnus-tmp-process-marked
+ (if (member gnus-tmp-group gnus-group-marked)
+ gnus-process-mark ? ))
+ (gnus-tmp-grouplens
+ (or (and gnus-use-grouplens
+ (bbb-grouplens-group-p gnus-tmp-group))
+ ""))
+ (buffer-read-only nil)
+ header gnus-tmp-header) ; passed as parameter to user-funcs.
+ (beginning-of-line)
+ (gnus-add-text-properties
+ (point)
+ (prog1 (1+ (point))
+ ;; Insert the text.
+ (eval gnus-group-line-format-spec))
+ `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
+ gnus-unread ,(if (numberp number)
+ (string-to-int gnus-tmp-number-of-unread)
+ t)
+ gnus-marked ,gnus-tmp-marked-mark
+ gnus-indentation ,gnus-group-indentation
+ gnus-level ,gnus-tmp-level))
+ (when (inline (gnus-visual-p 'group-highlight 'highlight))
+ (forward-line -1)
+ (run-hooks 'gnus-group-update-hook)
+ (forward-line))
+ ;; Allow XEmacs to remove front-sticky text properties.
+ (gnus-group-remove-excess-properties)))
+
+(defun gnus-group-highlight-line ()
+ "Highlight the current line according to `gnus-group-highlight'."
+ (let* ((list gnus-group-highlight)
+ (p (point))
+ (end (progn (end-of-line) (point)))
+ ;; now find out where the line starts and leave point there.
+ (beg (progn (beginning-of-line) (point)))
+ (group (gnus-group-group-name))
+ (entry (gnus-group-entry group))
+ (unread (if (numberp (car entry)) (car entry) 0))
+ (active (gnus-active group))
+ (total (if active (1+ (- (cdr active) (car active))) 0))
+ (info (nth 2 entry))
+ (method (gnus-server-get-method group (gnus-info-method info)))
+ (marked (gnus-info-marks info))
+ (mailp (memq 'mail (assoc (symbol-name
+ (car (or method gnus-select-method)))
+ gnus-valid-select-methods)))
+ (level (or (gnus-info-level info) 9))
+ (score (or (gnus-info-score info) 0))
+ (ticked (gnus-range-length (cdr (assq 'tick marked))))
+ (group-age (gnus-group-timestamp-delta group))
+ (inhibit-read-only t))
+ ;; Eval the cars of the lists until we find a match.
+ (while (and list
+ (not (eval (caar list))))
+ (setq list (cdr list)))
+ (let ((face (cdar list)))
+ (unless (eq face (get-text-property beg 'face))
+ (gnus-put-text-property
+ beg end 'face
+ (setq face (if (boundp face) (symbol-value face) face)))
+ (gnus-extent-start-open beg)))
+ (goto-char p)))
+
+(defun gnus-group-update-group (group &optional visible-only)
+ "Update all lines where GROUP appear.
+If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
+already."
+ ;; Can't use `save-excursion' here, so we do it manually.
+ (let ((buf (current-buffer))
+ mark)
+ (set-buffer gnus-group-buffer)
+ (setq mark (point-marker))
+ ;; The buffer may be narrowed.
+ (save-restriction
+ (widen)
+ (let ((ident (gnus-intern-safe group gnus-active-hashtb))
+ (loc (point-min))
+ found buffer-read-only)
+ ;; Enter the current status into the dribble buffer.
+ (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
+ (when (and entry (not (gnus-ephemeral-group-p group)))
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (nth 2 entry))
+ ")"))))
+ ;; Find all group instances. If topics are in use, each group
+ ;; may be listed in more than once.
+ (while (setq loc (text-property-any
+ loc (point-max) 'gnus-group ident))
+ (setq found t)
+ (goto-char loc)
+ (let ((gnus-group-indentation (gnus-group-group-indentation)))
+ (gnus-delete-line)
+ (gnus-group-insert-group-line-info group)
+ (save-excursion
+ (forward-line -1)
+ (run-hooks 'gnus-group-update-group-hook)))
+ (setq loc (1+ loc)))
+ (unless (or found visible-only)
+ ;; No such line in the buffer, find out where it's supposed to
+ ;; go, and insert it there (or at the end of the buffer).
+ (if gnus-goto-missing-group-function
+ (funcall gnus-goto-missing-group-function group)
+ (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
+ (while (and entry (car entry)
+ (not
+ (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe
+ (caar entry) gnus-active-hashtb)))))
+ (setq entry (cdr entry)))
+ (or entry (goto-char (point-max)))))
+ ;; Finally insert the line.
+ (let ((gnus-group-indentation (gnus-group-group-indentation)))
+ (gnus-group-insert-group-line-info group)
+ (save-excursion
+ (forward-line -1)
+ (run-hooks 'gnus-group-update-group-hook))))
+ (when gnus-group-update-group-function
+ (funcall gnus-group-update-group-function group))
+ (gnus-group-set-mode-line)))
+ (goto-char mark)
+ (set-marker mark nil)
+ (set-buffer buf)))
+
+(defun gnus-group-set-mode-line ()
+ "Update the mode line in the group buffer."
+ (when (memq 'group gnus-updated-mode-lines)
+ ;; Yes, we want to keep this mode line updated.
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (let* ((gformat (or gnus-group-mode-line-format-spec
+ (gnus-set-format 'group-mode)))
+ (gnus-tmp-news-server (cadr gnus-select-method))
+ (gnus-tmp-news-method (car gnus-select-method))
+ (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
+ (max-len 60)
+ gnus-tmp-header ;Dummy binding for user-defined formats
+ ;; Get the resulting string.
+ (modified
+ (and gnus-dribble-buffer
+ (buffer-name gnus-dribble-buffer)
+ (buffer-modified-p gnus-dribble-buffer)
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (not (zerop (buffer-size))))))
+ (mode-string (eval gformat)))
+ ;; Say whether the dribble buffer has been modified.
+ (setq mode-line-modified
+ (if modified (car gnus-mode-line-modified)
+ (cdr gnus-mode-line-modified)))
+ ;; If the line is too long, we chop it off.
+ (when (> (length mode-string) max-len)
+ (setq mode-string (substring mode-string 0 (- max-len 4))))
+ (prog1
+ (setq mode-line-buffer-identification
+ (gnus-mode-line-buffer-identification
+ (list mode-string)))
+ (set-buffer-modified-p modified))))))
+
+(defun gnus-group-group-name ()
+ "Get the name of the newsgroup on the current line."
+ (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
+ (and group (symbol-name group))))
+
+(defun gnus-group-group-level ()
+ "Get the level of the newsgroup on the current line."
+ (get-text-property (gnus-point-at-bol) 'gnus-level))
+
+(defun gnus-group-group-indentation ()
+ "Get the indentation of the newsgroup on the current line."
+ (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
+ (and gnus-group-indentation-function
+ (funcall gnus-group-indentation-function))
+ ""))
+
+(defun gnus-group-group-unread ()
+ "Get the number of unread articles of the newsgroup on the current line."
+ (get-text-property (gnus-point-at-bol) 'gnus-unread))
+
+(defun gnus-group-new-mail (group)
+ (if (nnmail-new-mail-p (gnus-group-real-name group))
+ gnus-new-mail-mark
+ ? ))
+
+(defun gnus-group-level (group)
+ "Return the estimated level of GROUP."
+ (or (gnus-info-level (gnus-get-info group))
+ (and (member group gnus-zombie-list) 8)
+ 9))
+
+(defun gnus-group-search-forward (&optional backward all level first-too)
+ "Find the next newsgroup with unread articles.
+If BACKWARD is non-nil, find the previous newsgroup instead.
+If ALL is non-nil, just find any newsgroup.
+If LEVEL is non-nil, find group with level LEVEL, or higher if no such
+group exists.
+If FIRST-TOO, the current line is also eligible as a target."
+ (let ((way (if backward -1 1))
+ (low gnus-level-killed)
+ (beg (point))
+ pos found lev)
+ (if (and backward (progn (beginning-of-line)) (bobp))
+ nil
+ (unless first-too
+ (forward-line way))
+ (while (and
+ (not (eobp))
+ (not (setq
+ found
+ (and
+ (get-text-property (point) 'gnus-group)
+ (or all
+ (and
+ (let ((unread
+ (get-text-property (point) 'gnus-unread)))
+ (and (numberp unread) (> unread 0)))
+ (setq lev (get-text-property (point)
+ 'gnus-level))
+ (<= lev gnus-level-subscribed)))
+ (or (not level)
+ (and (setq lev (get-text-property (point)
+ 'gnus-level))
+ (or (= lev level)
+ (and (< lev low)
+ (< level lev)
+ (progn
+ (setq low lev)
+ (setq pos (point))
+ nil))))))))
+ (zerop (forward-line way)))))
+ (if found
+ (progn (gnus-group-position-point) t)
+ (goto-char (or pos beg))
+ (and pos t))))
+
+;;; Gnus group mode commands
+
+;; Group marking.
+
+(defun gnus-group-mark-group (n &optional unmark no-advance)
+ "Mark the current group."
+ (interactive "p")
+ (let ((buffer-read-only nil)
+ group)
+ (while (and (> n 0)
+ (not (eobp)))
+ (when (setq group (gnus-group-group-name))
+ ;; Go to the mark position.
+ (beginning-of-line)
+ (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
+ (subst-char-in-region
+ (point) (1+ (point)) (following-char)
+ (if unmark
+ (progn
+ (setq gnus-group-marked (delete group gnus-group-marked))
+ ? )
+ (setq gnus-group-marked
+ (cons group (delete group gnus-group-marked)))
+ gnus-process-mark)))
+ (unless no-advance
+ (gnus-group-next-group 1))
+ (decf n))
+ (gnus-summary-position-point)
+ n))
+
+(defun gnus-group-unmark-group (n)
+ "Remove the mark from the current group."
+ (interactive "p")
+ (gnus-group-mark-group n 'unmark)
+ (gnus-group-position-point))
+
+(defun gnus-group-unmark-all-groups ()
+ "Unmark all groups."
+ (interactive)
+ (let ((groups gnus-group-marked))
+ (save-excursion
+ (while groups
+ (gnus-group-remove-mark (pop groups)))))
+ (gnus-group-position-point))
+
+(defun gnus-group-mark-region (unmark beg end)
+ "Mark all groups between point and mark.
+If UNMARK, remove the mark instead."
+ (interactive "P\nr")
+ (let ((num (count-lines beg end)))
+ (save-excursion
+ (goto-char beg)
+ (- num (gnus-group-mark-group num unmark)))))
+
+(defun gnus-group-mark-buffer (&optional unmark)
+ "Mark all groups in the buffer.
+If UNMARK, remove the mark instead."
+ (interactive "P")
+ (gnus-group-mark-region unmark (point-min) (point-max)))
+
+(defun gnus-group-mark-regexp (regexp)
+ "Mark all groups that match some regexp."
+ (interactive "sMark (regexp): ")
+ (let ((alist (cdr gnus-newsrc-alist))
+ group)
+ (while alist
+ (when (string-match regexp (setq group (gnus-info-group (pop alist))))
+ (gnus-group-set-mark group))))
+ (gnus-group-position-point))
+
+(defun gnus-group-remove-mark (group)
+ "Remove the process mark from GROUP and move point there.
+Return nil if the group isn't displayed."
+ (if (gnus-group-goto-group group)
+ (save-excursion
+ (gnus-group-mark-group 1 'unmark t)
+ t)
+ (setq gnus-group-marked
+ (delete group gnus-group-marked))
+ nil))
+
+(defun gnus-group-set-mark (group)
+ "Set the process mark on GROUP."
+ (if (gnus-group-goto-group group)
+ (save-excursion
+ (gnus-group-mark-group 1 nil t))
+ (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
+
+(defun gnus-group-universal-argument (arg &optional groups func)
+ "Perform any command on all groups according to the process/prefix convention."
+ (interactive "P")
+ (if (eq (setq func (or func
+ (key-binding
+ (read-key-sequence
+ (substitute-command-keys
+ "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
+ 'undefined)
+ (gnus-error 1 "Undefined key")
+ (gnus-group-iterate arg
+ (lambda (group)
+ (command-execute func))))
+ (gnus-group-position-point))
+
+(defun gnus-group-process-prefix (n)
+ "Return a list of groups to work on.
+Take into consideration N (the prefix) and the list of marked groups."
+ (cond
+ (n
+ (setq n (prefix-numeric-value n))
+ ;; There is a prefix, so we return a list of the N next
+ ;; groups.
+ (let ((way (if (< n 0) -1 1))
+ (n (abs n))
+ group groups)
+ (save-excursion
+ (while (and (> n 0)
+ (setq group (gnus-group-group-name)))
+ (push group groups)
+ (setq n (1- n))
+ (gnus-group-next-group way)))
+ (nreverse groups)))
+ ((gnus-region-active-p)
+ ;; Work on the region between point and mark.
+ (let ((max (max (point) (mark)))
+ groups)
+ (save-excursion
+ (goto-char (min (point) (mark)))
+ (while
+ (and
+ (push (gnus-group-group-name) groups)
+ (zerop (gnus-group-next-group 1))
+ (< (point) max)))
+ (nreverse groups))))
+ (gnus-group-marked
+ ;; No prefix, but a list of marked articles.
+ (reverse gnus-group-marked))
+ (t
+ ;; Neither marked articles or a prefix, so we return the
+ ;; current group.
+ (let ((group (gnus-group-group-name)))
+ (and group (list group))))))
+
+(eval-and-compile
+ (let ((function (make-symbol "gnus-group-iterate-function"))
+ (window (make-symbol "gnus-group-iterate-window"))
+ (groups (make-symbol "gnus-group-iterate-groups"))
+ (group (make-symbol "gnus-group-iterate-group")))
+ (eval
+ `(defun gnus-group-iterate (arg ,function)
+ "Iterate FUNCTION over all process/prefixed groups.
+FUNCTION will be called with the group name as the paremeter
+and with point over the group in question."
+ (let ((,groups (gnus-group-process-prefix arg))
+ (,window (selected-window))
+ ,group)
+ (while (setq ,group (pop ,groups))
+ (select-window ,window)
+ (gnus-group-remove-mark ,group)
+ (save-selected-window
+ (save-excursion
+ (funcall ,function ,group)))))))))
+
+(put 'gnus-group-iterate 'lisp-indent-function 1)
+
+;; Selecting groups.
+
+(defun gnus-group-read-group (&optional all no-article group)
+ "Read news in this newsgroup.
+If the prefix argument ALL is non-nil, already read articles become
+readable. IF ALL is a number, fetch this number of articles. If the
+optional argument NO-ARTICLE is non-nil, no article will be
+auto-selected upon group entry. If GROUP is non-nil, fetch that
+group."
+ (interactive "P")
+ (let ((no-display (eq all 0))
+ (group (or group (gnus-group-group-name)))
+ number active marked entry)
+ (when (eq all 0)
+ (setq all nil))
+ (unless group
+ (error "No group on current line"))
+ (setq marked (gnus-info-marks
+ (nth 2 (setq entry (gnus-gethash
+ group gnus-newsrc-hashtb)))))
+ ;; This group might be a dead group. In that case we have to get
+ ;; the number of unread articles from `gnus-active-hashtb'.
+ (setq number
+ (cond ((numberp all) all)
+ (entry (car entry))
+ ((setq active (gnus-active group))
+ (- (1+ (cdr active)) (car active)))))
+ (gnus-summary-read-group
+ group (or all (and (numberp number)
+ (zerop (+ number (gnus-range-length
+ (cdr (assq 'tick marked)))
+ (gnus-range-length
+ (cdr (assq 'dormant marked)))))))
+ no-article nil no-display)))
+
+(defun gnus-group-select-group (&optional all)
+ "Select this newsgroup.
+No article is selected automatically.
+If ALL is non-nil, already read articles become readable.
+If ALL is a number, fetch this number of articles."
+ (interactive "P")
+ (gnus-group-read-group all t))
+
+(defun gnus-group-quick-select-group (&optional all)
+ "Select the current group \"quickly\".
+This means that no highlighting or scoring will be performed.
+If ALL (the prefix argument) is 0, don't even generate the summary
+buffer.
+
+This might be useful if you want to toggle threading
+before entering the group."
+ (interactive "P")
+ (require 'gnus-score)
+ (let (gnus-visual
+ gnus-score-find-score-files-function
+ gnus-home-score-file
+ gnus-apply-kill-hook
+ gnus-summary-expunge-below)
+ (gnus-group-read-group all t)))
+
+(defun gnus-group-visible-select-group (&optional all)
+ "Select the current group without hiding any articles."
+ (interactive "P")
+ (let ((gnus-inhibit-limiting t))
+ (gnus-group-read-group all t)))
+
+(defun gnus-group-select-group-ephemerally ()
+ "Select the current group without doing any processing whatsoever.
+You will actually be entered into a group that's a copy of
+the current group; no changes you make while in this group will
+be permanent."
+ (interactive)
+ (require 'gnus-score)
+ (let* (gnus-visual
+ gnus-score-find-score-files-function gnus-apply-kill-hook
+ gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates
+ gnus-summary-mode-hook gnus-select-group-hook
+ (group (gnus-group-group-name))
+ (method (gnus-find-method-for-group group)))
+ (setq method
+ `(,(car method) ,(concat (cadr method) "-ephemeral")
+ (,(intern (format "%s-address" (car method))) ,(cadr method))
+ ,@(cddr method)))
+ (gnus-group-read-ephemeral-group
+ (gnus-group-prefixed-name group method) method)))
+
+;;;###autoload
+(defun gnus-fetch-group (group)
+ "Start Gnus if necessary and enter GROUP.
+Returns whether the fetching was successful or not."
+ (interactive "sGroup name: ")
+ (unless (get-buffer gnus-group-buffer)
+ (gnus))
+ (gnus-group-read-group nil nil group))
+
+(defvar gnus-ephemeral-group-server 0)
+
+;; Enter a group that is not in the group buffer. Non-nil is returned
+;; if selection was successful.
+(defun gnus-group-read-ephemeral-group (group method &optional activate
+ quit-config request-only)
+ "Read GROUP from METHOD as an ephemeral group.
+If ACTIVATE, request the group first.
+If QUIT-CONFIG, use that window configuration when exiting from the
+ephemeral group.
+If REQUEST-ONLY, don't actually read the group; just request it.
+
+Return the name of the group is selection was successful."
+ ;; Transform the select method into a unique server.
+ (let ((saddr (intern (format "%s-address" (car method)))))
+ (setq method (gnus-copy-sequence method))
+ (require (car method))
+ (when (boundp saddr)
+ (unless (assq saddr method)
+ (nconc method `((,saddr ,(cadr method))))
+ (setf (cadr method) (format "%s-%d" (cadr method)
+ (incf gnus-ephemeral-group-server))))))
+ (let ((group (if (gnus-group-foreign-p group) group
+ (gnus-group-prefixed-name group method))))
+ (gnus-sethash
+ group
+ `(-1 nil (,group
+ ,gnus-level-default-subscribed nil nil ,method
+ ((quit-config .
+ ,(if quit-config quit-config
+ (cons gnus-summary-buffer
+ gnus-current-window-configuration))))))
+ gnus-newsrc-hashtb)
+ (set-buffer gnus-group-buffer)
+ (unless (gnus-check-server method)
+ (error "Unable to contact server: %s" (gnus-status-message method)))
+ (when activate
+ (gnus-activate-group group 'scan)
+ (unless (gnus-request-group group)
+ (error "Couldn't request group: %s"
+ (nnheader-get-report (car method)))))
+ (if request-only
+ group
+ (condition-case ()
+ (when (gnus-group-read-group t t group)
+ group)
+ ;;(error nil)
+ (quit nil)))))
+
+(defun gnus-group-jump-to-group (group)
+ "Jump to newsgroup GROUP."
+ (interactive
+ (list (completing-read
+ "Group: " gnus-active-hashtb nil
+ (gnus-read-active-file-p)
+ nil
+ 'gnus-group-history)))
+
+ (when (equal group "")
+ (error "Empty group name"))
+
+ (unless (gnus-ephemeral-group-p group)
+ ;; Either go to the line in the group buffer...
+ (unless (gnus-group-goto-group group)
+ ;; ... or insert the line.
+ (gnus-group-update-group group)
+ (gnus-group-goto-group group)))
+ ;; Adjust cursor point.
+ (gnus-group-position-point))
+
+(defun gnus-group-goto-group (group &optional far)
+ "Goto to newsgroup GROUP.
+If FAR, it is likely that the group is not on the current line."
+ (when group
+ (if far
+ (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))
+ (beginning-of-line)
+ (cond
+ ;; It's quite likely that we are on the right line, so
+ ;; we check the current line first.
+ ((eq (get-text-property (point) 'gnus-group)
+ (gnus-intern-safe group gnus-active-hashtb))
+ (point))
+ ;; Previous and next line are also likely, so we check them as well.
+ ((save-excursion
+ (forward-line -1)
+ (eq (get-text-property (point) 'gnus-group)
+ (gnus-intern-safe group gnus-active-hashtb)))
+ (forward-line -1)
+ (point))
+ ((save-excursion
+ (forward-line 1)
+ (eq (get-text-property (point) 'gnus-group)
+ (gnus-intern-safe group gnus-active-hashtb)))
+ (forward-line 1)
+ (point))
+ (t
+ ;; Search through the entire buffer.
+ (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))))
+
+(defun gnus-group-next-group (n &optional silent)
+ "Go to next N'th newsgroup.
+If N is negative, search backward instead.
+Returns the difference between N and the number of skips actually
+done."
+ (interactive "p")
+ (gnus-group-next-unread-group n t nil silent))
+
+(defun gnus-group-next-unread-group (n &optional all level silent)
+ "Go to next N'th unread newsgroup.
+If N is negative, search backward instead.
+If ALL is non-nil, choose any newsgroup, unread or not.
+If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
+such group can be found, the next group with a level higher than
+LEVEL.
+Returns the difference between N and the number of skips actually
+made."
+ (interactive "p")
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (while (and (> n 0)
+ (gnus-group-search-forward
+ backward (or (not gnus-group-goto-unread) all) level))
+ (setq n (1- n)))
+ (when (and (/= 0 n)
+ (not silent))
+ (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
+ (if level " on this level or higher" "")))
+ n))
+
+(defun gnus-group-prev-group (n)
+ "Go to previous N'th newsgroup.
+Returns the difference between N and the number of skips actually
+done."
+ (interactive "p")
+ (gnus-group-next-unread-group (- n) t))
+
+(defun gnus-group-prev-unread-group (n)
+ "Go to previous N'th unread newsgroup.
+Returns the difference between N and the number of skips actually
+done."
+ (interactive "p")
+ (gnus-group-next-unread-group (- n)))
+
+(defun gnus-group-next-unread-group-same-level (n)
+ "Go to next N'th unread newsgroup on the same level.
+If N is negative, search backward instead.
+Returns the difference between N and the number of skips actually
+done."
+ (interactive "p")
+ (gnus-group-next-unread-group n t (gnus-group-group-level))
+ (gnus-group-position-point))
+
+(defun gnus-group-prev-unread-group-same-level (n)
+ "Go to next N'th unread newsgroup on the same level.
+Returns the difference between N and the number of skips actually
+done."
+ (interactive "p")
+ (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
+ (gnus-group-position-point))
+
+(defun gnus-group-best-unread-group (&optional exclude-group)
+ "Go to the group with the highest level.
+If EXCLUDE-GROUP, do not go to that group."
+ (interactive)
+ (goto-char (point-min))
+ (let ((best 100000)
+ unread best-point)
+ (while (not (eobp))
+ (setq unread (get-text-property (point) 'gnus-unread))
+ (when (and (numberp unread) (> unread 0))
+ (when (and (get-text-property (point) 'gnus-level)
+ (< (get-text-property (point) 'gnus-level) best)
+ (or (not exclude-group)
+ (not (equal exclude-group (gnus-group-group-name)))))
+ (setq best (get-text-property (point) 'gnus-level))
+ (setq best-point (point))))
+ (forward-line 1))
+ (when best-point
+ (goto-char best-point))
+ (gnus-summary-position-point)
+ (and best-point (gnus-group-group-name))))
+
+(defun gnus-group-first-unread-group ()
+ "Go to the first group with unread articles."
+ (interactive)
+ (prog1
+ (let ((opoint (point))
+ unread)
+ (goto-char (point-min))
+ (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
+ (and (numberp unread) ; Not a topic.
+ (not (zerop unread))) ; Has unread articles.
+ (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
+ (point) ; Success.
+ (goto-char opoint)
+ nil)) ; Not success.
+ (gnus-group-position-point)))
+
+(defun gnus-group-enter-server-mode ()
+ "Jump to the server buffer."
+ (interactive)
+ (gnus-enter-server-buffer))
+
+(defun gnus-group-make-group (name &optional method address args)
+ "Add a new newsgroup.
+The user will be prompted for a NAME, for a select METHOD, and an
+ADDRESS."
+ (interactive
+ (list
+ (gnus-read-group "Group name: ")
+ (gnus-read-method "From method: ")))
+
+ (let* ((meth (when (and method
+ (not (gnus-server-equal method gnus-select-method)))
+ (if address (list (intern method) address)
+ method)))
+ (nname (if method (gnus-group-prefixed-name name meth) name))
+ backend info)
+ (when (gnus-gethash nname gnus-newsrc-hashtb)
+ (error "Group %s already exists" nname))
+ ;; Subscribe to the new group.
+ (gnus-group-change-level
+ (setq info (list t nname gnus-level-default-subscribed nil nil meth))
+ gnus-level-default-subscribed gnus-level-killed
+ (and (gnus-group-group-name)
+ (gnus-gethash (gnus-group-group-name)
+ gnus-newsrc-hashtb))
+ t)
+ ;; Make it active.
+ (gnus-set-active nname (cons 1 0))
+ (unless (gnus-ephemeral-group-p name)
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (cdr info)) ")")))
+ ;; Insert the line.
+ (gnus-group-insert-group-line-info nname)
+ (forward-line -1)
+ (gnus-group-position-point)
+
+ ;; Load the backend and try to make the backend create
+ ;; the group as well.
+ (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
+ nil meth))))
+ gnus-valid-select-methods)
+ (require backend))
+ (gnus-check-server meth)
+ (when (gnus-check-backend-function 'request-create-group nname)
+ (gnus-request-create-group nname nil args))
+ t))
+
+(defun gnus-group-delete-group (group &optional force)
+ "Delete the current group. Only meaningful with mail groups.
+If FORCE (the prefix) is non-nil, all the articles in the group will
+be deleted. This is \"deleted\" as in \"removed forever from the face
+of the Earth\". There is no undo. The user will be prompted before
+doing the deletion."
+ (interactive
+ (list (gnus-group-group-name)
+ current-prefix-arg))
+ (unless group
+ (error "No group to rename"))
+ (unless (gnus-check-backend-function 'request-delete-group group)
+ (error "This backend does not support group deletion"))
+ (prog1
+ (if (not (gnus-yes-or-no-p
+ (format
+ "Do you really want to delete %s%s? "
+ group (if force " and all its contents" ""))))
+ () ; Whew!
+ (gnus-message 6 "Deleting group %s..." group)
+ (if (not (gnus-request-delete-group group force))
+ (gnus-error 3 "Couldn't delete group %s" group)
+ (gnus-message 6 "Deleting group %s...done" group)
+ (gnus-group-goto-group group)
+ (gnus-group-kill-group 1 t)
+ (gnus-sethash group nil gnus-active-hashtb)
+ t))
+ (gnus-group-position-point)))
+
+(defun gnus-group-rename-group (group new-name)
+ "Rename group from GROUP to NEW-NAME.
+When used interactively, GROUP is the group under point
+and NEW-NAME will be prompted for."
+ (interactive
+ (list
+ (gnus-group-group-name)
+ (progn
+ (unless (gnus-check-backend-function
+ 'request-rename-group (gnus-group-group-name))
+ (error "This backend does not support renaming groups"))
+ (gnus-read-group "Rename group to: "
+ (gnus-group-real-name (gnus-group-group-name))))))
+
+ (unless (gnus-check-backend-function 'request-rename-group group)
+ (error "This backend does not support renaming groups"))
+ (unless group
+ (error "No group to rename"))
+ (when (equal (gnus-group-real-name group) new-name)
+ (error "Can't rename to the same name"))
+
+ ;; We find the proper prefixed name.
+ (setq new-name
+ (if (gnus-group-native-p group)
+ ;; Native group.
+ new-name
+ ;; Foreign group.
+ (gnus-group-prefixed-name
+ (gnus-group-real-name new-name)
+ (gnus-info-method (gnus-get-info group)))))
+
+ (gnus-message 6 "Renaming group %s to %s..." group new-name)
+ (prog1
+ (if (not (gnus-request-rename-group group new-name))
+ (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
+ ;; We rename the group internally by killing it...
+ (gnus-group-goto-group group)
+ (gnus-group-kill-group)
+ ;; ... changing its name ...
+ (setcar (cdar gnus-list-of-killed-groups) new-name)
+ ;; ... and then yanking it. Magic!
+ (gnus-group-yank-group)
+ (gnus-set-active new-name (gnus-active group))
+ (gnus-message 6 "Renaming group %s to %s...done" group new-name)
+ new-name)
+ (gnus-group-position-point)))
+
+(defun gnus-group-edit-group (group &optional part)
+ "Edit the group on the current line."
+ (interactive (list (gnus-group-group-name)))
+ (let ((part (or part 'info))
+ info)
+ (unless group
+ (error "No group on current line"))
+ (unless (setq info (gnus-get-info group))
+ (error "Killed group; can't be edited"))
+ (ignore-errors
+ (gnus-close-group group))
+ (gnus-edit-form
+ ;; Find the proper form to edit.
+ (cond ((eq part 'method)
+ (or (gnus-info-method info) "native"))
+ ((eq part 'params)
+ (gnus-info-params info))
+ (t info))
+ ;; The proper documentation.
+ (format
+ "Editing the %s for `%s'."
+ (cond
+ ((eq part 'method) "select method")
+ ((eq part 'params) "group parameters")
+ (t "group info"))
+ group)
+ `(lambda (form)
+ (gnus-group-edit-group-done ',part ,group form)))))
+
+(defun gnus-group-edit-group-method (group)
+ "Edit the select method of GROUP."
+ (interactive (list (gnus-group-group-name)))
+ (gnus-group-edit-group group 'method))
+
+(defun gnus-group-edit-group-parameters (group)
+ "Edit the group parameters of GROUP."
+ (interactive (list (gnus-group-group-name)))
+ (gnus-group-edit-group group 'params))
+
+(defun gnus-group-edit-group-done (part group form)
+ "Update variables."
+ (let* ((method (cond ((eq part 'info) (nth 4 form))
+ ((eq part 'method) form)
+ (t nil)))
+ (info (cond ((eq part 'info) form)
+ ((eq part 'method) (gnus-get-info group))
+ (t nil)))
+ (new-group (if info
+ (if (or (not method)
+ (gnus-server-equal
+ gnus-select-method method))
+ (gnus-group-real-name (car info))
+ (gnus-group-prefixed-name
+ (gnus-group-real-name (car info)) method))
+ nil)))
+ (when (and new-group
+ (not (equal new-group group)))
+ (when (gnus-group-goto-group group)
+ (gnus-group-kill-group 1))
+ (gnus-activate-group new-group))
+ ;; Set the info.
+ (if (not (and info new-group))
+ (gnus-group-set-info form (or new-group group) part)
+ (setq info (gnus-copy-sequence info))
+ (setcar info new-group)
+ (unless (gnus-server-equal method "native")
+ (unless (nthcdr 3 info)
+ (nconc info (list nil nil)))
+ (unless (nthcdr 4 info)
+ (nconc info (list nil)))
+ (gnus-info-set-method info method))
+ (gnus-group-set-info info))
+ (gnus-group-update-group (or new-group group))
+ (gnus-group-position-point)))
+
+(defun gnus-group-make-useful-group (group method)
+ (interactive
+ (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
+ nil t)
+ gnus-useful-groups)))
+ (list (cadr entry) (caddr entry))))
+ (setq method (gnus-copy-sequence method))
+ (let (entry)
+ (while (setq entry (memq (assq 'eval method) method))
+ (setcar entry (eval (cadar entry)))))
+ (gnus-group-make-group group method))
+
+(defun gnus-group-make-help-group ()
+ "Create the Gnus documentation group."
+ (interactive)
+ (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
+ (file (nnheader-find-etc-directory "gnus-tut.txt" t))
+ dir)
+ (when (gnus-gethash name gnus-newsrc-hashtb)
+ (error "Documentation group already exists"))
+ (if (not file)
+ (gnus-message 1 "Couldn't find doc group")
+ (gnus-group-make-group
+ (gnus-group-real-name name)
+ (list 'nndoc "gnus-help"
+ (list 'nndoc-address file)
+ (list 'nndoc-article-type 'mbox)))))
+ (gnus-group-position-point))
+
+(defun gnus-group-make-doc-group (file type)
+ "Create a group that uses a single file as the source."
+ (interactive
+ (list (read-file-name "File name: ")
+ (and current-prefix-arg 'ask)))
+ (when (eq type 'ask)
+ (let ((err "")
+ char found)
+ (while (not found)
+ (message
+ "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: "
+ err)
+ (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
+ ((= char ?b) 'babyl)
+ ((= char ?d) 'digest)
+ ((= char ?f) 'forward)
+ ((= char ?a) 'mmfd)
+ (t (setq err (format "%c unknown. " char))
+ nil))))
+ (setq type found)))
+ (let* ((file (expand-file-name file))
+ (name (gnus-generate-new-group-name
+ (gnus-group-prefixed-name
+ (file-name-nondirectory file) '(nndoc "")))))
+ (gnus-group-make-group
+ (gnus-group-real-name name)
+ (list 'nndoc file
+ (list 'nndoc-address file)
+ (list 'nndoc-article-type (or type 'guess))))))
+
+(defvar nnweb-type-definition)
+(defvar gnus-group-web-type-history nil)
+(defvar gnus-group-web-search-history nil)
+(defun gnus-group-make-web-group (&optional solid)
+ "Create an ephemeral nnweb group.
+If SOLID (the prefix), create a solid group."
+ (interactive "P")
+ (require 'nnweb)
+ (let* ((group
+ (if solid (gnus-read-group "Group name: ")
+ (message-unique-id)))
+ (default-type (or (car gnus-group-web-type-history)
+ (symbol-name (caar nnweb-type-definition))))
+ (type
+ (gnus-string-or
+ (completing-read
+ (format "Search engine type (default %s): " default-type)
+ (mapcar (lambda (elem) (list (symbol-name (car elem))))
+ nnweb-type-definition)
+ nil t nil 'gnus-group-web-type-history)
+ default-type))
+ (search
+ (read-string
+ "Search string: "
+ (cons (or (car gnus-group-web-search-history) "") 0)
+ 'gnus-group-web-search-history))
+ (method
+ `(nnweb ,group (nnweb-search ,search)
+ (nnweb-type ,(intern type))
+ (nnweb-ephemeral-p t))))
+ (if solid
+ (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search))
+ (gnus-group-read-ephemeral-group
+ group method t
+ (cons (current-buffer)
+ (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
+
+(defun gnus-group-make-archive-group (&optional all)
+ "Create the (ding) Gnus archive group of the most recent articles.
+Given a prefix, create a full group."
+ (interactive "P")
+ (let ((group (gnus-group-prefixed-name
+ (if all "ding.archives" "ding.recent") '(nndir ""))))
+ (when (gnus-gethash group gnus-newsrc-hashtb)
+ (error "Archive group already exists"))
+ (gnus-group-make-group
+ (gnus-group-real-name group)
+ (list 'nndir (if all "hpc" "edu")
+ (list 'nndir-directory
+ (if all gnus-group-archive-directory
+ gnus-group-recent-archive-directory))))
+ (gnus-group-add-parameter group (cons 'to-address "ding@gnus.org"))))
+
+(defun gnus-group-make-directory-group (dir)
+ "Create an nndir group.
+The user will be prompted for a directory. The contents of this
+directory will be used as a newsgroup. The directory should contain
+mail messages or news articles in files that have numeric names."
+ (interactive
+ (list (read-file-name "Create group from directory: ")))
+ (unless (file-exists-p dir)
+ (error "No such directory"))
+ (unless (file-directory-p dir)
+ (error "Not a directory"))
+ (let ((ext "")
+ (i 0)
+ group)
+ (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
+ (setq group
+ (gnus-group-prefixed-name
+ (concat (file-name-as-directory (directory-file-name dir))
+ ext)
+ '(nndir "")))
+ (setq ext (format "<%d>" (setq i (1+ i)))))
+ (gnus-group-make-group
+ (gnus-group-real-name group)
+ (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
+
+(defun gnus-group-make-kiboze-group (group address scores)
+ "Create an nnkiboze group.
+The user will be prompted for a name, a regexp to match groups, and
+score file entries for articles to include in the group."
+ (interactive
+ (list
+ (read-string "nnkiboze group name: ")
+ (read-string "Source groups (regexp): ")
+ (let ((headers (mapcar (lambda (group) (list group))
+ '("subject" "from" "number" "date" "message-id"
+ "references" "chars" "lines" "xref"
+ "followup" "all" "body" "head")))
+ scores header regexp regexps)
+ (while (not (equal "" (setq header (completing-read
+ "Match on header: " headers nil t))))
+ (setq regexps nil)
+ (while (not (equal "" (setq regexp (read-string
+ (format "Match on %s (string): "
+ header)))))
+ (push (list regexp nil nil 'r) regexps))
+ (push (cons header regexps) scores))
+ scores)))
+ (gnus-group-make-group group "nnkiboze" address)
+ (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
+ (let (emacs-lisp-mode-hook)
+ (pp scores (current-buffer)))))
+
+(defun gnus-group-add-to-virtual (n vgroup)
+ "Add the current group to a virtual group."
+ (interactive
+ (list current-prefix-arg
+ (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
+ "nnvirtual:")))
+ (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
+ (error "%s is not an nnvirtual group" vgroup))
+ (gnus-close-group vgroup)
+ (let* ((groups (gnus-group-process-prefix n))
+ (method (gnus-info-method (gnus-get-info vgroup))))
+ (setcar (cdr method)
+ (concat
+ (nth 1 method) "\\|"
+ (mapconcat
+ (lambda (s)
+ (gnus-group-remove-mark s)
+ (concat "\\(^" (regexp-quote s) "$\\)"))
+ groups "\\|"))))
+ (gnus-group-position-point))
+
+(defun gnus-group-make-empty-virtual (group)
+ "Create a new, fresh, empty virtual group."
+ (interactive "sCreate new, empty virtual group: ")
+ (let* ((method (list 'nnvirtual "^$"))
+ (pgroup (gnus-group-prefixed-name group method)))
+ ;; Check whether it exists already.
+ (when (gnus-gethash pgroup gnus-newsrc-hashtb)
+ (error "Group %s already exists" pgroup))
+ ;; Subscribe the new group after the group on the current line.
+ (gnus-subscribe-group pgroup (gnus-group-group-name) method)
+ (gnus-group-update-group pgroup)
+ (forward-line -1)
+ (gnus-group-position-point)))
+
+(defun gnus-group-enter-directory (dir)
+ "Enter an ephemeral nneething group."
+ (interactive "DDirectory to read: ")
+ (let* ((method (list 'nneething dir '(nneething-read-only t)))
+ (leaf (gnus-group-prefixed-name
+ (file-name-nondirectory (directory-file-name dir))
+ method))
+ (name (gnus-generate-new-group-name leaf)))
+ (unless (gnus-group-read-ephemeral-group
+ name method t
+ (cons (current-buffer)
+ (if (eq major-mode 'gnus-summary-mode)
+ 'summary 'group)))
+ (error "Couldn't enter %s" dir))))
+
+;; Group sorting commands
+;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
+
+(defun gnus-group-sort-groups (func &optional reverse)
+ "Sort the group buffer according to FUNC.
+When used interactively, the sorting function used will be
+determined by the `gnus-group-sort-function' variable.
+If REVERSE (the prefix), reverse the sorting order."
+ (interactive (list gnus-group-sort-function current-prefix-arg))
+ (funcall gnus-group-sort-alist-function
+ (gnus-make-sort-function func) reverse)
+ (gnus-group-list-groups)
+ (gnus-dribble-touch))
+
+(defun gnus-group-sort-flat (func reverse)
+ ;; We peel off the dummy group from the alist.
+ (when func
+ (when (equal (gnus-info-group (car gnus-newsrc-alist)) "dummy.group")
+ (pop gnus-newsrc-alist))
+ ;; Do the sorting.
+ (setq gnus-newsrc-alist
+ (sort gnus-newsrc-alist func))
+ (when reverse
+ (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
+ ;; Regenerate the hash table.
+ (gnus-make-hashtable-from-newsrc-alist)))
+
+(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
+ "Sort the group buffer alphabetically by group name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
+
+(defun gnus-group-sort-groups-by-unread (&optional reverse)
+ "Sort the group buffer by number of unread articles.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
+
+(defun gnus-group-sort-groups-by-level (&optional reverse)
+ "Sort the group buffer by group level.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
+
+(defun gnus-group-sort-groups-by-score (&optional reverse)
+ "Sort the group buffer by group score.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
+
+(defun gnus-group-sort-groups-by-rank (&optional reverse)
+ "Sort the group buffer by group rank.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
+
+(defun gnus-group-sort-groups-by-method (&optional reverse)
+ "Sort the group buffer alphabetically by backend name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
+
+;;; Selected group sorting.
+
+(defun gnus-group-sort-selected-groups (n func &optional reverse)
+ "Sort the process/prefixed groups."
+ (interactive (list current-prefix-arg gnus-group-sort-function))
+ (let ((groups (gnus-group-process-prefix n)))
+ (funcall gnus-group-sort-selected-function
+ groups (gnus-make-sort-function func) reverse)
+ (gnus-group-list-groups)))
+
+(defun gnus-group-sort-selected-flat (groups func reverse)
+ (let (entries infos)
+ ;; First find all the group entries for these groups.
+ (while groups
+ (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb))
+ entries))
+ ;; Then sort the infos.
+ (setq infos
+ (sort
+ (mapcar
+ (lambda (entry) (car entry))
+ (setq entries (nreverse entries)))
+ func))
+ (when reverse
+ (setq infos (nreverse infos)))
+ ;; Go through all the infos and replace the old entries
+ ;; with the new infos.
+ (while infos
+ (setcar entries (pop infos))
+ (pop entries))
+ ;; Update the hashtable.
+ (gnus-make-hashtable-from-newsrc-alist)))
+
+(defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse)
+ "Sort the group buffer alphabetically by group name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse))
+
+(defun gnus-group-sort-selected-groups-by-unread (&optional reverse)
+ "Sort the group buffer by number of unread articles.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse))
+
+(defun gnus-group-sort-selected-groups-by-level (&optional reverse)
+ "Sort the group buffer by group level.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse))
+
+(defun gnus-group-sort-selected-groups-by-score (&optional reverse)
+ "Sort the group buffer by group score.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse))
+
+(defun gnus-group-sort-selected-groups-by-rank (&optional reverse)
+ "Sort the group buffer by group rank.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse))
+
+(defun gnus-group-sort-selected-groups-by-method (&optional reverse)
+ "Sort the group buffer alphabetically by backend name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse))
+
+;;; Sorting predicates.
+
+(defun gnus-group-sort-by-alphabet (info1 info2)
+ "Sort alphabetically."
+ (string< (gnus-info-group info1) (gnus-info-group info2)))
+
+(defun gnus-group-sort-by-real-name (info1 info2)
+ "Sort alphabetically on real (unprefixed) names."
+ (string< (gnus-group-real-name (gnus-info-group info1))
+ (gnus-group-real-name (gnus-info-group info2))))
+
+(defun gnus-group-sort-by-unread (info1 info2)
+ "Sort by number of unread articles."
+ (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
+ (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
+ (< (or (and (numberp n1) n1) 0)
+ (or (and (numberp n2) n2) 0))))
+
+(defun gnus-group-sort-by-level (info1 info2)
+ "Sort by level."
+ (< (gnus-info-level info1) (gnus-info-level info2)))
+
+(defun gnus-group-sort-by-method (info1 info2)
+ "Sort alphabetically by backend name."
+ (string< (symbol-name (car (gnus-find-method-for-group
+ (gnus-info-group info1) info1)))
+ (symbol-name (car (gnus-find-method-for-group
+ (gnus-info-group info2) info2)))))
+
+(defun gnus-group-sort-by-score (info1 info2)
+ "Sort by group score."
+ (< (gnus-info-score info1) (gnus-info-score info2)))
+
+(defun gnus-group-sort-by-rank (info1 info2)
+ "Sort by level and score."
+ (let ((level1 (gnus-info-level info1))
+ (level2 (gnus-info-level info2)))
+ (or (< level1 level2)
+ (and (= level1 level2)
+ (> (gnus-info-score info1) (gnus-info-score info2))))))
+
+;;; Clearing data
+
+(defun gnus-group-clear-data (&optional arg)
+ "Clear all marks and read ranges from the current group."
+ (interactive "P")
+ (gnus-group-iterate arg
+ (lambda (group)
+ (let (info)
+ (gnus-info-clear-data (setq info (gnus-get-info group)))
+ (gnus-get-unread-articles-in-group info (gnus-active group) t)
+ (when (gnus-group-goto-group group)
+ (gnus-group-update-group-line))))))
+
+(defun gnus-group-clear-data-on-native-groups ()
+ "Clear all marks and read ranges from all native groups."
+ (interactive)
+ (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ")
+ (let ((alist (cdr gnus-newsrc-alist))
+ info)
+ (while (setq info (pop alist))
+ (when (gnus-group-native-p (gnus-info-group info))
+ (gnus-info-clear-data info)))
+ (gnus-get-unread-articles)
+ (gnus-dribble-enter "")
+ (when (gnus-y-or-n-p
+ "Move the cache away to avoid problems in the future? ")
+ (call-interactively 'gnus-cache-move-cache)))))
+
+(defun gnus-info-clear-data (info)
+ "Clear all marks and read ranges from INFO."
+ (let ((group (gnus-info-group info)))
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (when (gnus-group-goto-group ,group)
+ (gnus-group-update-group-line))))
+ (gnus-info-set-read info nil)
+ (when (gnus-info-marks info)
+ (gnus-info-set-marks info nil))))
+
+;; Group catching up.
+
+(defun gnus-group-catchup-current (&optional n all)
+ "Mark all articles not marked as unread in current newsgroup as read.
+If prefix argument N is numeric, the ARG next newsgroups will be
+caught up. If ALL is non-nil, marked articles will also be marked as
+read. Cross references (Xref: header) of articles are ignored.
+The difference between N and actual number of newsgroups that were
+caught up is returned."
+ (interactive "P")
+ (unless (gnus-group-group-name)
+ (error "No group on the current line"))
+ (let ((groups (gnus-group-process-prefix n))
+ (ret 0))
+ (if (not
+ (or (not gnus-interactive-catchup) ;Without confirmation?
+ gnus-expert-user
+ (gnus-y-or-n-p
+ (format
+ (if all
+ "Do you really want to mark all articles in %s as read? "
+ "Mark all unread articles in %s as read? ")
+ (if (= (length groups) 1)
+ (car groups)
+ (format "these %d groups" (length groups)))))))
+ n
+ (while groups
+ ;; Virtual groups have to be given special treatment.
+ (let ((method (gnus-find-method-for-group (car groups))))
+ (when (eq 'nnvirtual (car method))
+ (nnvirtual-catchup-group
+ (gnus-group-real-name (car groups)) (nth 1 method) all)))
+ (gnus-group-remove-mark (car groups))
+ (if (>= (gnus-group-group-level) gnus-level-zombie)
+ (gnus-message 2 "Dead groups can't be caught up")
+ (if (prog1
+ (gnus-group-goto-group (car groups))
+ (gnus-group-catchup (car groups) all))
+ (gnus-group-update-group-line)
+ (setq ret (1+ ret))))
+ (setq groups (cdr groups)))
+ (gnus-group-next-unread-group 1)
+ ret)))
+
+(defun gnus-group-catchup-current-all (&optional n)
+ "Mark all articles in current newsgroup as read.
+Cross references (Xref: header) of articles are ignored."
+ (interactive "P")
+ (gnus-group-catchup-current n 'all))
+
+(defun gnus-group-catchup (group &optional all)
+ "Mark all articles in GROUP as read.
+If ALL is non-nil, all articles are marked as read.
+The return value is the number of articles that were marked as read,
+or nil if no action could be taken."
+ (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ (num (car entry)))
+ ;; Do the updating only if the newsgroup isn't killed.
+ (if (not (numberp (car entry)))
+ (gnus-message 1 "Can't catch up %s; non-active group" group)
+ ;; Do auto-expirable marks if that's required.
+ (when (gnus-group-auto-expirable-p group)
+ (gnus-add-marked-articles
+ group 'expire (gnus-list-of-unread-articles group))
+ (when all
+ (let ((marks (nth 3 (nth 2 entry))))
+ (gnus-add-marked-articles
+ group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
+ (gnus-add-marked-articles
+ group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
+ (when entry
+ (gnus-update-read-articles group nil)
+ ;; Also nix out the lists of marks and dormants.
+ (when all
+ (gnus-add-marked-articles group 'tick nil nil 'force)
+ (gnus-add-marked-articles group 'dormant nil nil 'force))
+ (let ((gnus-newsgroup-name group))
+ (run-hooks 'gnus-group-catchup-group-hook))
+ num))))
+
+(defun gnus-group-expire-articles (&optional n)
+ "Expire all expirable articles in the current newsgroup."
+ (interactive "P")
+ (let ((groups (gnus-group-process-prefix n))
+ group)
+ (unless groups
+ (error "No groups to expire"))
+ (while (setq group (pop groups))
+ (gnus-group-remove-mark group)
+ (when (gnus-check-backend-function 'request-expire-articles group)
+ (gnus-message 6 "Expiring articles in %s..." group)
+ (let* ((info (gnus-get-info group))
+ (expirable (if (gnus-group-total-expirable-p group)
+ (cons nil (gnus-list-of-read-articles group))
+ (assq 'expire (gnus-info-marks info))))
+ (expiry-wait (gnus-group-find-parameter group 'expiry-wait)))
+ (when expirable
+ (setcdr
+ expirable
+ (gnus-compress-sequence
+ (if expiry-wait
+ ;; We set the expiry variables to the group
+ ;; parameter.
+ (let ((nnmail-expiry-wait-function nil)
+ (nnmail-expiry-wait expiry-wait))
+ (gnus-request-expire-articles
+ (gnus-uncompress-sequence (cdr expirable)) group))
+ ;; Just expire using the normal expiry values.
+ (gnus-request-expire-articles
+ (gnus-uncompress-sequence (cdr expirable)) group))))
+ (gnus-close-group group))
+ (gnus-message 6 "Expiring articles in %s...done" group)))
+ (gnus-dribble-touch)
+ (gnus-group-position-point))))
+
+(defun gnus-group-expire-all-groups ()
+ "Expire all expirable articles in all newsgroups."
+ (interactive)
+ (save-excursion
+ (gnus-message 5 "Expiring...")
+ (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
+ (cdr gnus-newsrc-alist))))
+ (gnus-group-expire-articles nil)))
+ (gnus-group-position-point)
+ (gnus-message 5 "Expiring...done"))
+
+(defun gnus-group-set-current-level (n level)
+ "Set the level of the next N groups to LEVEL."
+ (interactive
+ (list
+ current-prefix-arg
+ (string-to-int
+ (let ((s (read-string
+ (format "Level (default %s): "
+ (or (gnus-group-group-level)
+ gnus-level-default-subscribed)))))
+ (if (string-match "^\\s-*$" s)
+ (int-to-string (or (gnus-group-group-level)
+ gnus-level-default-subscribed))
+ s)))))
+ (unless (and (>= level 1) (<= level gnus-level-killed))
+ (error "Illegal level: %d" level))
+ (let ((groups (gnus-group-process-prefix n))
+ group)
+ (while (setq group (pop groups))
+ (gnus-group-remove-mark group)
+ (gnus-message 6 "Changed level of %s from %d to %d"
+ group (or (gnus-group-group-level) gnus-level-killed)
+ level)
+ (gnus-group-change-level
+ group level (or (gnus-group-group-level) gnus-level-killed))
+ (gnus-group-update-group-line)))
+ (gnus-group-position-point))
+
+(defun gnus-group-unsubscribe (&optional n)
+ "Unsubscribe the current group."
+ (interactive "P")
+ (gnus-group-unsubscribe-current-group n 'unsubscribe))
+
+(defun gnus-group-subscribe (&optional n)
+ "Subscribe the current group."
+ (interactive "P")
+ (gnus-group-unsubscribe-current-group n 'subscribe))
+
+(defun gnus-group-unsubscribe-current-group (&optional n do-sub)
+ "Toggle subscription of the current group.
+If given numerical prefix, toggle the N next groups."
+ (interactive "P")
+ (let ((groups (gnus-group-process-prefix n))
+ group)
+ (while groups
+ (setq group (car groups)
+ groups (cdr groups))
+ (gnus-group-remove-mark group)
+ (gnus-group-unsubscribe-group
+ group
+ (cond
+ ((eq do-sub 'unsubscribe)
+ gnus-level-default-unsubscribed)
+ ((eq do-sub 'subscribe)
+ gnus-level-default-subscribed)
+ ((<= (gnus-group-group-level) gnus-level-subscribed)
+ gnus-level-default-unsubscribed)
+ (t
+ gnus-level-default-subscribed))
+ t)
+ (gnus-group-update-group-line))
+ (gnus-group-next-group 1)))
+
+(defun gnus-group-unsubscribe-group (group &optional level silent)
+ "Toggle subscription to GROUP.
+Killed newsgroups are subscribed. If SILENT, don't try to update the
+group line."
+ (interactive
+ (list (completing-read
+ "Group: " gnus-active-hashtb nil
+ (gnus-read-active-file-p)
+ nil
+ 'gnus-group-history)))
+ (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
+ (cond
+ ((string-match "^[ \t]$" group)
+ (error "Empty group name"))
+ (newsrc
+ ;; Toggle subscription flag.
+ (gnus-group-change-level
+ newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc))
+ gnus-level-subscribed)
+ (1+ gnus-level-subscribed)
+ gnus-level-default-subscribed)))
+ (unless silent
+ (gnus-group-update-group group)))
+ ((and (stringp group)
+ (or (not (gnus-read-active-file-p))
+ (gnus-active group)))
+ ;; Add new newsgroup.
+ (gnus-group-change-level
+ group
+ (if level level gnus-level-default-subscribed)
+ (or (and (member group gnus-zombie-list)
+ gnus-level-zombie)
+ gnus-level-killed)
+ (when (gnus-group-group-name)
+ (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
+ (unless silent
+ (gnus-group-update-group group)))
+ (t (error "No such newsgroup: %s" group)))
+ (gnus-group-position-point)))
+
+(defun gnus-group-transpose-groups (n)
+ "Move the current newsgroup up N places.
+If given a negative prefix, move down instead. The difference between
+N and the number of steps taken is returned."
+ (interactive "p")
+ (unless (gnus-group-group-name)
+ (error "No group on current line"))
+ (gnus-group-kill-group 1)
+ (prog1
+ (forward-line (- n))
+ (gnus-group-yank-group)
+ (gnus-group-position-point)))
+
+(defun gnus-group-kill-all-zombies ()
+ "Kill all zombie newsgroups."
+ (interactive)
+ (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
+ (setq gnus-zombie-list nil)
+ (gnus-dribble-touch)
+ (gnus-group-list-groups))
+
+(defun gnus-group-kill-region (begin end)
+ "Kill newsgroups in current region (excluding current point).
+The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
+ (interactive "r")
+ (let ((lines
+ ;; Count lines.
+ (save-excursion
+ (count-lines
+ (progn
+ (goto-char begin)
+ (beginning-of-line)
+ (point))
+ (progn
+ (goto-char end)
+ (beginning-of-line)
+ (point))))))
+ (goto-char begin)
+ (beginning-of-line) ;Important when LINES < 1
+ (gnus-group-kill-group lines)))
+
+(defun gnus-group-kill-group (&optional n discard)
+ "Kill the next N groups.
+The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
+However, only groups that were alive can be yanked; already killed
+groups or zombie groups can't be yanked.
+The return value is the name of the group that was killed, or a list
+of groups killed."
+ (interactive "P")
+ (let ((buffer-read-only nil)
+ (groups (gnus-group-process-prefix n))
+ group entry level out)
+ (if (< (length groups) 10)
+ ;; This is faster when there are few groups.
+ (while groups
+ (push (setq group (pop groups)) out)
+ (gnus-group-remove-mark group)
+ (setq level (gnus-group-group-level))
+ (gnus-delete-line)
+ (when (and (not discard)
+ (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
+ (gnus-undo-register
+ `(progn
+ (gnus-group-goto-group ,(gnus-group-group-name))
+ (gnus-group-yank-group)))
+ (push (cons (car entry) (nth 2 entry))
+ gnus-list-of-killed-groups))
+ (gnus-group-change-level
+ (if entry entry group) gnus-level-killed (if entry nil level)))
+ ;; If there are lots and lots of groups to be killed, we use
+ ;; this thing instead.
+ (let (entry)
+ (setq groups (nreverse groups))
+ (while groups
+ (gnus-group-remove-mark (setq group (pop groups)))
+ (gnus-delete-line)
+ (push group gnus-killed-list)
+ (setq gnus-newsrc-alist
+ (delq (assoc group gnus-newsrc-alist)
+ gnus-newsrc-alist))
+ (when gnus-group-change-level-function
+ (funcall gnus-group-change-level-function group 9 3))
+ (cond
+ ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
+ (push (cons (car entry) (nth 2 entry))
+ gnus-list-of-killed-groups)
+ (setcdr (cdr entry) (cdddr entry)))
+ ((member group gnus-zombie-list)
+ (setq gnus-zombie-list (delete group gnus-zombie-list)))))
+ (gnus-make-hashtable-from-newsrc-alist)))
+
+ (gnus-group-position-point)
+ (if (< (length out) 2) (car out) (nreverse out))))
+
+(defun gnus-group-yank-group (&optional arg)
+ "Yank the last newsgroups killed with \\[gnus-group-kill-group],
+inserting it before the current newsgroup. The numeric ARG specifies
+how many newsgroups are to be yanked. The name of the newsgroup yanked
+is returned, or (if several groups are yanked) a list of yanked groups
+is returned."
+ (interactive "p")
+ (setq arg (or arg 1))
+ (let (info group prev out)
+ (while (>= (decf arg) 0)
+ (when (not (setq info (pop gnus-list-of-killed-groups)))
+ (error "No more newsgroups to yank"))
+ (push (setq group (nth 1 info)) out)
+ ;; Find which newsgroup to insert this one before - search
+ ;; backward until something suitable is found. If there are no
+ ;; other newsgroups in this buffer, just make this newsgroup the
+ ;; first newsgroup.
+ (setq prev (gnus-group-group-name))
+ (gnus-group-change-level
+ info (gnus-info-level (cdr info)) gnus-level-killed
+ (and prev (gnus-gethash prev gnus-newsrc-hashtb))
+ t)
+ (gnus-group-insert-group-line-info group)
+ (gnus-undo-register
+ `(when (gnus-group-goto-group ,group)
+ (gnus-group-kill-group 1))))
+ (forward-line -1)
+ (gnus-group-position-point)
+ (if (< (length out) 2) (car out) (nreverse out))))
+
+(defun gnus-group-kill-level (level)
+ "Kill all groups that is on a certain LEVEL."
+ (interactive "nKill all groups on level: ")
+ (cond
+ ((= level gnus-level-zombie)
+ (setq gnus-killed-list
+ (nconc gnus-zombie-list gnus-killed-list))
+ (setq gnus-zombie-list nil))
+ ((and (< level gnus-level-zombie)
+ (> level 0)
+ (or gnus-expert-user
+ (gnus-yes-or-no-p
+ (format
+ "Do you really want to kill all groups on level %d? "
+ level))))
+ (let* ((prev gnus-newsrc-alist)
+ (alist (cdr prev)))
+ (while alist
+ (if (= (gnus-info-level (car alist)) level)
+ (progn
+ (push (gnus-info-group (car alist)) gnus-killed-list)
+ (setcdr prev (cdr alist)))
+ (setq prev alist))
+ (setq alist (cdr alist)))
+ (gnus-make-hashtable-from-newsrc-alist)
+ (gnus-group-list-groups)))
+ (t
+ (error "Can't kill; illegal level: %d" level))))
+
+(defun gnus-group-list-all-groups (&optional arg)
+ "List all newsgroups with level ARG or lower.
+Default is gnus-level-unsubscribed, which lists all subscribed and most
+unsubscribed groups."
+ (interactive "P")
+ (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
+
+;; Redefine this to list ALL killed groups if prefix arg used.
+;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
+(defun gnus-group-list-killed (&optional arg)
+ "List all killed newsgroups in the group buffer.
+If ARG is non-nil, list ALL killed groups known to Gnus. This may
+entail asking the server for the groups."
+ (interactive "P")
+ ;; Find all possible killed newsgroups if arg.
+ (when arg
+ (gnus-get-killed-groups))
+ (if (not gnus-killed-list)
+ (gnus-message 6 "No killed groups")
+ (let (gnus-group-list-mode)
+ (funcall gnus-group-prepare-function
+ gnus-level-killed t gnus-level-killed))
+ (goto-char (point-min)))
+ (gnus-group-position-point))
+
+(defun gnus-group-list-zombies ()
+ "List all zombie newsgroups in the group buffer."
+ (interactive)
+ (if (not gnus-zombie-list)
+ (gnus-message 6 "No zombie groups")
+ (let (gnus-group-list-mode)
+ (funcall gnus-group-prepare-function
+ gnus-level-zombie t gnus-level-zombie))
+ (goto-char (point-min)))
+ (gnus-group-position-point))
+
+(defun gnus-group-list-active ()
+ "List all groups that are available from the server(s)."
+ (interactive)
+ ;; First we make sure that we have really read the active file.
+ (unless (gnus-read-active-file-p)
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file)))
+ ;; Find all groups and sort them.
+ (let ((groups
+ (sort
+ (let (list)
+ (mapatoms
+ (lambda (sym)
+ (and (boundp sym)
+ (symbol-value sym)
+ (push (symbol-name sym) list)))
+ gnus-active-hashtb)
+ list)
+ 'string<))
+ (buffer-read-only nil)
+ group)
+ (erase-buffer)
+ (while groups
+ (gnus-add-text-properties
+ (point) (prog1 (1+ (point))
+ (insert " *: "
+ (setq group (pop groups)) "\n"))
+ (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
+ 'gnus-unread t
+ 'gnus-level (inline (gnus-group-level group)))))
+ (goto-char (point-min))))
+
+(defun gnus-activate-all-groups (level)
+ "Activate absolutely all groups."
+ (interactive (list 7))
+ (let ((gnus-activate-level level)
+ (gnus-activate-foreign-newsgroups level))
+ (gnus-group-get-new-news)))
+
+(defun gnus-group-get-new-news (&optional arg)
+ "Get newly arrived articles.
+If ARG is a number, it specifies which levels you are interested in
+re-scanning. If ARG is non-nil and not a number, this will force
+\"hard\" re-reading of the active files from all servers."
+ (interactive "P")
+ (let ((gnus-inhibit-demon t))
+ (run-hooks 'gnus-get-new-news-hook)
+
+ ;; Read any slave files.
+ (unless gnus-slave
+ (gnus-master-read-slave-newsrc))
+
+ ;; We might read in new NoCeM messages here.
+ (when (and gnus-use-nocem
+ (null arg))
+ (gnus-nocem-scan-groups))
+ ;; If ARG is not a number, then we read the active file.
+ (when (and arg (not (numberp arg)))
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file))
+ (setq arg nil)
+
+ ;; If the user wants it, we scan for new groups.
+ (when (eq gnus-check-new-newsgroups 'always)
+ (gnus-find-new-newsgroups)))
+
+ (setq arg (gnus-group-default-level arg t))
+ (if (and gnus-read-active-file (not arg))
+ (progn
+ (gnus-read-active-file)
+ (gnus-get-unread-articles arg))
+ (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
+ (gnus-get-unread-articles arg)))
+ (run-hooks 'gnus-after-getting-new-news-hook)
+ (gnus-group-list-groups (and (numberp arg)
+ (max (car gnus-group-list-mode) arg)))))
+
+(defun gnus-group-get-new-news-this-group (&optional n dont-scan)
+ "Check for newly arrived news in the current group (and the N-1 next groups).
+The difference between N and the number of newsgroup checked is returned.
+If N is negative, this group and the N-1 previous groups will be checked."
+ (interactive "P")
+ (let* ((groups (gnus-group-process-prefix n))
+ (ret (if (numberp n) (- n (length groups)) 0))
+ (beg (unless n
+ (point)))
+ group)
+ (while (setq group (pop groups))
+ (gnus-group-remove-mark group)
+ ;; Bypass any previous denials from the server.
+ (gnus-remove-denial (gnus-find-method-for-group group))
+ (if (gnus-activate-group group (if dont-scan nil 'scan))
+ (progn
+ (gnus-get-unread-articles-in-group
+ (gnus-get-info group) (gnus-active group) t)
+ (unless (gnus-virtual-group-p group)
+ (gnus-close-group group))
+ (gnus-group-update-group group))
+ (if (eq (gnus-server-status (gnus-find-method-for-group group))
+ 'denied)
+ (gnus-error 3 "Server denied access")
+ (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
+ (when beg
+ (goto-char beg))
+ (when gnus-goto-next-group-when-activating
+ (gnus-group-next-unread-group 1 t))
+ (gnus-summary-position-point)
+ ret))
+
+(defun gnus-group-fetch-faq (group &optional faq-dir)
+ "Fetch the FAQ for the current group.
+If given a prefix argument, prompt for the FAQ dir
+to use."
+ (interactive
+ (list
+ (gnus-group-group-name)
+ (when current-prefix-arg
+ (completing-read
+ "Faq dir: " (and (listp gnus-group-faq-directory)
+ (mapcar (lambda (file) (list file))
+ gnus-group-faq-directory))))))
+ (unless group
+ (error "No group name given"))
+ (let ((dirs (or faq-dir gnus-group-faq-directory))
+ dir found file)
+ (unless (listp dirs)
+ (setq dirs (list dirs)))
+ (while (and (not found)
+ (setq dir (pop dirs)))
+ (setq file (concat (file-name-as-directory dir)
+ (gnus-group-real-name group)))
+ (if (not (file-exists-p file))
+ (gnus-message 1 "No such file: %s" file)
+ (let ((enable-local-variables nil))
+ (find-file file)
+ (setq found t))))))
+
+(defun gnus-group-describe-group (force &optional group)
+ "Display a description of the current newsgroup."
+ (interactive (list current-prefix-arg (gnus-group-group-name)))
+ (let* ((method (gnus-find-method-for-group group))
+ (mname (gnus-group-prefixed-name "" method))
+ desc)
+ (when (and force
+ gnus-description-hashtb)
+ (gnus-sethash mname nil gnus-description-hashtb))
+ (unless group
+ (error "No group name given"))
+ (when (or (and gnus-description-hashtb
+ ;; We check whether this group's method has been
+ ;; queried for a description file.
+ (gnus-gethash mname gnus-description-hashtb))
+ (setq desc (gnus-group-get-description group))
+ (gnus-read-descriptions-file method))
+ (gnus-message 1
+ (or desc (gnus-gethash group gnus-description-hashtb)
+ "No description available")))))
+
+;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
+(defun gnus-group-describe-all-groups (&optional force)
+ "Pop up a buffer with descriptions of all newsgroups."
+ (interactive "P")
+ (when force
+ (setq gnus-description-hashtb nil))
+ (when (not (or gnus-description-hashtb
+ (gnus-read-all-descriptions-files)))
+ (error "Couldn't request descriptions file"))
+ (let ((buffer-read-only nil)
+ b)
+ (erase-buffer)
+ (mapatoms
+ (lambda (group)
+ (setq b (point))
+ (insert (format " *: %-20s %s\n" (symbol-name group)
+ (symbol-value group)))
+ (gnus-add-text-properties
+ b (1+ b) (list 'gnus-group group
+ 'gnus-unread t 'gnus-marked nil
+ 'gnus-level (1+ gnus-level-subscribed))))
+ gnus-description-hashtb)
+ (goto-char (point-min))
+ (gnus-group-position-point)))
+
+;; Suggested by Daniel Quinlan <quinlan@best.com>.
+(defun gnus-group-apropos (regexp &optional search-description)
+ "List all newsgroups that have names that match a regexp."
+ (interactive "sGnus apropos (regexp): ")
+ (let ((prev "")
+ (obuf (current-buffer))
+ groups des)
+ ;; Go through all newsgroups that are known to Gnus.
+ (mapatoms
+ (lambda (group)
+ (and (symbol-name group)
+ (string-match regexp (symbol-name group))
+ (push (symbol-name group) groups)))
+ gnus-active-hashtb)
+ ;; Also go through all descriptions that are known to Gnus.
+ (when search-description
+ (mapatoms
+ (lambda (group)
+ (and (string-match regexp (symbol-value group))
+ (gnus-active (symbol-name group))
+ (push (symbol-name group) groups)))
+ gnus-description-hashtb))
+ (if (not groups)
+ (gnus-message 3 "No groups matched \"%s\"." regexp)
+ ;; Print out all the groups.
+ (save-excursion
+ (pop-to-buffer "*Gnus Help*")
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (setq groups (sort groups 'string<))
+ (while groups
+ ;; Groups may be entered twice into the list of groups.
+ (when (not (string= (car groups) prev))
+ (insert (setq prev (car groups)) "\n")
+ (when (and gnus-description-hashtb
+ (setq des (gnus-gethash (car groups)
+ gnus-description-hashtb)))
+ (insert " " des "\n")))
+ (setq groups (cdr groups)))
+ (goto-char (point-min))))
+ (pop-to-buffer obuf)))
+
+(defun gnus-group-description-apropos (regexp)
+ "List all newsgroups that have names or descriptions that match a regexp."
+ (interactive "sGnus description apropos (regexp): ")
+ (when (not (or gnus-description-hashtb
+ (gnus-read-all-descriptions-files)))
+ (error "Couldn't request descriptions file"))
+ (gnus-group-apropos regexp t))
+
+;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
+(defun gnus-group-list-matching (level regexp &optional all lowest)
+ "List all groups with unread articles that match REGEXP.
+If the prefix LEVEL is non-nil, it should be a number that says which
+level to cut off listing groups.
+If ALL, also list groups with no unread articles.
+If LOWEST, don't list groups with level lower than LOWEST.
+
+This command may read the active file."
+ (interactive "P\nsList newsgroups matching: ")
+ ;; First make sure active file has been read.
+ (when (and level
+ (> (prefix-numeric-value level) gnus-level-killed))
+ (gnus-get-killed-groups))
+ (gnus-group-prepare-flat
+ (or level gnus-level-subscribed) all (or lowest 1) regexp)
+ (goto-char (point-min))
+ (gnus-group-position-point))
+
+(defun gnus-group-list-all-matching (level regexp &optional lowest)
+ "List all groups that match REGEXP.
+If the prefix LEVEL is non-nil, it should be a number that says which
+level to cut off listing groups.
+If LOWEST, don't list groups with level lower than LOWEST."
+ (interactive "P\nsList newsgroups matching: ")
+ (when level
+ (setq level (prefix-numeric-value level)))
+ (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
+
+;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
+(defun gnus-group-save-newsrc (&optional force)
+ "Save the Gnus startup files.
+If FORCE, force saving whether it is necessary or not."
+ (interactive "P")
+ (gnus-save-newsrc-file force))
+
+(defun gnus-group-restart (&optional arg)
+ "Force Gnus to read the .newsrc file."
+ (interactive "P")
+ (when (gnus-yes-or-no-p
+ (format "Are you sure you want to restart Gnus? "))
+ (gnus-save-newsrc-file)
+ (gnus-clear-system)
+ (gnus)))
+
+(defun gnus-group-read-init-file ()
+ "Read the Gnus elisp init file."
+ (interactive)
+ (gnus-read-init-file)
+ (gnus-message 5 "Read %s" gnus-init-file))
+
+(defun gnus-group-check-bogus-groups (&optional silent)
+ "Check bogus newsgroups.
+If given a prefix, don't ask for confirmation before removing a bogus
+group."
+ (interactive "P")
+ (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
+ (gnus-group-list-groups))
+
+(defun gnus-group-find-new-groups (&optional arg)
+ "Search for new groups and add them.
+Each new group will be treated with `gnus-subscribe-newsgroup-method.'
+If ARG (the prefix), use the `ask-server' method to query
+the server for new groups."
+ (interactive "P")
+ (gnus-find-new-newsgroups arg)
+ (gnus-group-list-groups))
+
+(defun gnus-group-edit-global-kill (&optional article group)
+ "Edit the global kill file.
+If GROUP, edit that local kill file instead."
+ (interactive "P")
+ (setq gnus-current-kill-article article)
+ (gnus-kill-file-edit-file group)
+ (gnus-message
+ 6
+ (substitute-command-keys
+ (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
+ (if group "local" "global")))))
+
+(defun gnus-group-edit-local-kill (article group)
+ "Edit a local kill file."
+ (interactive (list nil (gnus-group-group-name)))
+ (gnus-group-edit-global-kill article group))
+
+(defun gnus-group-force-update ()
+ "Update `.newsrc' file."
+ (interactive)
+ (gnus-save-newsrc-file))
+
+(defun gnus-group-suspend ()
+ "Suspend the current Gnus session.
+In fact, cleanup buffers except for group mode buffer.
+The hook gnus-suspend-gnus-hook is called before actually suspending."
+ (interactive)
+ (run-hooks 'gnus-suspend-gnus-hook)
+ ;; Kill Gnus buffers except for group mode buffer.
+ (let* ((group-buf (get-buffer gnus-group-buffer))
+ ;; Do this on a separate list in case the user does a ^G before we finish
+ (gnus-buffer-list
+ (delete group-buf (delete gnus-dribble-buffer
+ (append gnus-buffer-list nil)))))
+ (while gnus-buffer-list
+ (gnus-kill-buffer (pop gnus-buffer-list)))
+ (gnus-kill-gnus-frames)
+ (when group-buf
+ (setq gnus-buffer-list (list group-buf))
+ (bury-buffer group-buf)
+ (delete-windows-on group-buf t))))
+
+(defun gnus-group-clear-dribble ()
+ "Clear all information from the dribble buffer."
+ (interactive)
+ (gnus-dribble-clear)
+ (gnus-message 7 "Cleared dribble buffer"))
+
+(defun gnus-group-exit ()
+ "Quit reading news after updating .newsrc.eld and .newsrc.
+The hook `gnus-exit-gnus-hook' is called before actually exiting."
+ (interactive)
+ (when
+ (or noninteractive ;For gnus-batch-kill
+ (not gnus-interactive-exit) ;Without confirmation
+ gnus-expert-user
+ (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
+ (run-hooks 'gnus-exit-gnus-hook)
+ ;; Offer to save data from non-quitted summary buffers.
+ (gnus-offer-save-summaries)
+ ;; Save the newsrc file(s).
+ (gnus-save-newsrc-file)
+ ;; Kill-em-all.
+ (gnus-close-backends)
+ ;; Reset everything.
+ (gnus-clear-system)
+ ;; Allow the user to do things after cleaning up.
+ (run-hooks 'gnus-after-exiting-gnus-hook)))
+
+(defun gnus-group-quit ()
+ "Quit reading news without updating .newsrc.eld or .newsrc.
+The hook `gnus-exit-gnus-hook' is called before actually exiting."
+ (interactive)
+ (when (or noninteractive ;For gnus-batch-kill
+ (zerop (buffer-size))
+ (not (gnus-server-opened gnus-select-method))
+ gnus-expert-user
+ (not gnus-current-startup-file)
+ (gnus-yes-or-no-p
+ (format "Quit reading news without saving %s? "
+ (file-name-nondirectory gnus-current-startup-file))))
+ (run-hooks 'gnus-exit-gnus-hook)
+ (gnus-configure-windows 'group t)
+ (gnus-dribble-save)
+ (gnus-close-backends)
+ (gnus-clear-system)
+ (gnus-kill-buffer gnus-group-buffer)
+ ;; Allow the user to do things after cleaning up.
+ (run-hooks 'gnus-after-exiting-gnus-hook)))
+
+(defun gnus-group-describe-briefly ()
+ "Give a one line description of the group mode commands."
+ (interactive)
+ (gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
+
+(defun gnus-group-browse-foreign-server (method)
+ "Browse a foreign news server.
+If called interactively, this function will ask for a select method
+ (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
+If not, METHOD should be a list where the first element is the method
+and the second element is the address."
+ (interactive
+ (list (let ((how (completing-read
+ "Which backend: "
+ (append gnus-valid-select-methods gnus-server-alist)
+ nil t (cons "nntp" 0) 'gnus-method-history)))
+ ;; We either got a backend name or a virtual server name.
+ ;; If the first, we also need an address.
+ (if (assoc how gnus-valid-select-methods)
+ (list (intern how)
+ ;; Suggested by mapjph@bath.ac.uk.
+ (completing-read
+ "Address: "
+ (mapcar (lambda (server) (list server))
+ gnus-secondary-servers)))
+ ;; We got a server name.
+ how))))
+ (gnus-browse-foreign-server method))
+
+(defun gnus-group-set-info (info &optional method-only-group part)
+ (let* ((entry (gnus-gethash
+ (or method-only-group (gnus-info-group info))
+ gnus-newsrc-hashtb))
+ (part-info info)
+ (info (if method-only-group (nth 2 entry) info))
+ method)
+ (when method-only-group
+ (unless entry
+ (error "Trying to change non-existent group %s" method-only-group))
+ ;; We have received parts of the actual group info - either the
+ ;; select method or the group parameters. We first check
+ ;; whether we have to extend the info, and if so, do that.
+ (let ((len (length info))
+ (total (if (eq part 'method) 5 6)))
+ (when (< len total)
+ (setcdr (nthcdr (1- len) info)
+ (make-list (- total len) nil)))
+ ;; Then we enter the new info.
+ (setcar (nthcdr (1- total) info) part-info)))
+ (unless entry
+ ;; This is a new group, so we just create it.
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (setq method (gnus-info-method info))
+ (when (gnus-server-equal method "native")
+ (setq method nil))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (if method
+ ;; It's a foreign group...
+ (gnus-group-make-group
+ (gnus-group-real-name (gnus-info-group info))
+ (if (stringp method) method
+ (prin1-to-string (car method)))
+ (and (consp method)
+ (nth 1 (gnus-info-method info))))
+ ;; It's a native group.
+ (gnus-group-make-group (gnus-info-group info))))
+ (gnus-message 6 "Note: New group created")
+ (setq entry
+ (gnus-gethash (gnus-group-prefixed-name
+ (gnus-group-real-name (gnus-info-group info))
+ (or (gnus-info-method info) gnus-select-method))
+ gnus-newsrc-hashtb))))
+ ;; Whether it was a new group or not, we now have the entry, so we
+ ;; can do the update.
+ (if entry
+ (progn
+ (setcar (nthcdr 2 entry) info)
+ (when (and (not (eq (car entry) t))
+ (gnus-active (gnus-info-group info)))
+ (setcar entry (length (gnus-list-of-unread-articles (car info))))))
+ (error "No such group: %s" (gnus-info-group info)))))
+
+(defun gnus-group-set-method-info (group select-method)
+ (gnus-group-set-info select-method group 'method))
+
+(defun gnus-group-set-params-info (group params)
+ (gnus-group-set-info params group 'params))
+
+(defun gnus-add-marked-articles (group type articles &optional info force)
+ ;; Add ARTICLES of TYPE to the info of GROUP.
+ ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
+ ;; add, but replace marked articles of TYPE with ARTICLES.
+ (let ((info (or info (gnus-get-info group)))
+ (uncompressed '(score bookmark killed))
+ marked m)
+ (or (not info)
+ (and (not (setq marked (nthcdr 3 info)))
+ (or (null articles)
+ (setcdr (nthcdr 2 info)
+ (list (list (cons type (gnus-compress-sequence
+ articles t)))))))
+ (and (not (setq m (assq type (car marked))))
+ (or (null articles)
+ (setcar marked
+ (cons (cons type (gnus-compress-sequence articles t) )
+ (car marked)))))
+ (if force
+ (if (null articles)
+ (setcar (nthcdr 3 info)
+ (delq (assq type (car marked)) (car marked)))
+ (setcdr m (gnus-compress-sequence articles t)))
+ (setcdr m (gnus-compress-sequence
+ (sort (nconc (gnus-uncompress-range (cdr m))
+ (copy-sequence articles)) '<) t))))))
+
+;;;
+;;; Group timestamps
+;;;
+
+(defun gnus-group-set-timestamp ()
+ "Change the timestamp of the current group to the current time.
+This function can be used in hooks like `gnus-select-group-hook'
+or `gnus-group-catchup-group-hook'."
+ (when gnus-newsgroup-name
+ (let ((time (current-time)))
+ (setcdr (cdr time) nil)
+ (gnus-group-set-parameter gnus-newsgroup-name 'timestamp time))))
+
+(defsubst gnus-group-timestamp (group)
+ "Return the timestamp for GROUP."
+ (gnus-group-get-parameter group 'timestamp))
+
+(defun gnus-group-timestamp-delta (group)
+ "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
+ (let* ((time (or (gnus-group-timestamp group)
+ (list 0 0)))
+ (delta (gnus-time-minus (current-time) time)))
+ (+ (* (nth 0 delta) 65536.0)
+ (nth 1 delta))))
+
+(defun gnus-group-timestamp-string (group)
+ "Return a string of the timestamp for GROUP."
+ (let ((time (gnus-group-timestamp group)))
+ (if (not time)
+ ""
+ (gnus-time-iso8601 time))))
+
+(provide 'gnus-group)
+
+;;; gnus-group.el ends here
--- /dev/null
+;;; gnus-int.el --- backend interface functions for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+
+(defcustom gnus-open-server-hook nil
+ "Hook called just before opening connection to the news server."
+ :group 'gnus-start
+ :type 'hook)
+
+;;;
+;;; Server Communication
+;;;
+
+(defun gnus-start-news-server (&optional confirm)
+ "Open a method for getting news.
+If CONFIRM is non-nil, the user will be asked for an NNTP server."
+ (let (how)
+ (if gnus-current-select-method
+ ;; Stream is already opened.
+ nil
+ ;; Open NNTP server.
+ (unless gnus-nntp-service
+ (setq gnus-nntp-server nil))
+ (when confirm
+ ;; Read server name with completion.
+ (setq gnus-nntp-server
+ (completing-read "NNTP server: "
+ (mapcar (lambda (server) (list server))
+ (cons (list gnus-nntp-server)
+ gnus-secondary-servers))
+ nil nil gnus-nntp-server)))
+
+ (when (and gnus-nntp-server
+ (stringp gnus-nntp-server)
+ (not (string= gnus-nntp-server "")))
+ (setq gnus-select-method
+ (cond ((or (string= gnus-nntp-server "")
+ (string= gnus-nntp-server "::"))
+ (list 'nnspool (system-name)))
+ ((string-match "^:" gnus-nntp-server)
+ (list 'nnmh gnus-nntp-server
+ (list 'nnmh-directory
+ (file-name-as-directory
+ (expand-file-name
+ (concat "~/" (substring
+ gnus-nntp-server 1)))))
+ (list 'nnmh-get-new-mail nil)))
+ (t
+ (list 'nntp gnus-nntp-server)))))
+
+ (setq how (car gnus-select-method))
+ (cond
+ ((eq how 'nnspool)
+ (require 'nnspool)
+ (gnus-message 5 "Looking up local news spool..."))
+ ((eq how 'nnmh)
+ (require 'nnmh)
+ (gnus-message 5 "Looking up mh spool..."))
+ (t
+ (require 'nntp)))
+ (setq gnus-current-select-method gnus-select-method)
+ (run-hooks 'gnus-open-server-hook)
+ (or
+ ;; gnus-open-server-hook might have opened it
+ (gnus-server-opened gnus-select-method)
+ (gnus-open-server gnus-select-method)
+ (gnus-y-or-n-p
+ (format
+ "%s (%s) open error: '%s'. Continue? "
+ (car gnus-select-method) (cadr gnus-select-method)
+ (gnus-status-message gnus-select-method)))
+ (gnus-error 1 "Couldn't open server on %s"
+ (nth 1 gnus-select-method))))))
+
+(defun gnus-check-group (group)
+ "Try to make sure that the server where GROUP exists is alive."
+ (let ((method (gnus-find-method-for-group group)))
+ (or (gnus-server-opened method)
+ (gnus-open-server method))))
+
+(defun gnus-check-server (&optional method silent)
+ "Check whether the connection to METHOD is down.
+If METHOD is nil, use `gnus-select-method'.
+If it is down, start it up (again)."
+ (let ((method (or method gnus-select-method)))
+ ;; Transform virtual server names into select methods.
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ (if (gnus-server-opened method)
+ ;; The stream is already opened.
+ t
+ ;; Open the server.
+ (unless silent
+ (gnus-message 5 "Opening %s server%s..." (car method)
+ (if (equal (nth 1 method) "") ""
+ (format " on %s" (nth 1 method)))))
+ (run-hooks 'gnus-open-server-hook)
+ (prog1
+ (gnus-open-server method)
+ (unless silent
+ (message ""))))))
+
+(defun gnus-get-function (method function &optional noerror)
+ "Return a function symbol based on METHOD and FUNCTION."
+ ;; Translate server names into methods.
+ (unless method
+ (error "Attempted use of a nil select method"))
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ (let ((func (intern (format "%s-%s" (if gnus-agent
+ (gnus-agent-get-function method)
+ (car method))
+ function))))
+ ;; If the functions isn't bound, we require the backend in
+ ;; question.
+ (unless (fboundp func)
+ (require (car method))
+ (when (and (not (fboundp func))
+ (not noerror))
+ ;; This backend doesn't implement this function.
+ (error "No such function: %s" func)))
+ func))
+
+\f
+;;;
+;;; Interface functions to the backends.
+;;;
+
+(defun gnus-open-server (gnus-command-method)
+ "Open a connection to GNUS-COMMAND-METHOD."
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (let ((elem (assoc gnus-command-method gnus-opened-servers)))
+ ;; If this method was previously denied, we just return nil.
+ (if (eq (nth 1 elem) 'denied)
+ (progn
+ (gnus-message 1 "Denied server")
+ nil)
+ ;; Open the server.
+ (let ((result
+ (funcall (gnus-get-function gnus-command-method 'open-server)
+ (nth 1 gnus-command-method)
+ (nthcdr 2 gnus-command-method))))
+ ;; If this hasn't been opened before, we add it to the list.
+ (unless elem
+ (setq elem (list gnus-command-method nil)
+ gnus-opened-servers (cons elem gnus-opened-servers)))
+ ;; Set the status of this server.
+ (setcar (cdr elem) (if result 'ok 'denied))
+ ;; Return the result from the "open" call.
+ result))))
+
+(defun gnus-close-server (gnus-command-method)
+ "Close the connection to GNUS-COMMAND-METHOD."
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (funcall (gnus-get-function gnus-command-method 'close-server)
+ (nth 1 gnus-command-method)))
+
+(defun gnus-request-list (gnus-command-method)
+ "Request the active file from GNUS-COMMAND-METHOD."
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-list)
+ (nth 1 gnus-command-method)))
+
+(defun gnus-request-list-newsgroups (gnus-command-method)
+ "Request the newsgroups file from GNUS-COMMAND-METHOD."
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups)
+ (nth 1 gnus-command-method)))
+
+(defun gnus-request-newgroups (date gnus-command-method)
+ "Request all new groups since DATE from GNUS-COMMAND-METHOD."
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (let ((func (gnus-get-function gnus-command-method 'request-newgroups t)))
+ (when func
+ (funcall func date (nth 1 gnus-command-method)))))
+
+(defun gnus-server-opened (gnus-command-method)
+ "Check whether a connection to GNUS-COMMAND-METHOD has been opened."
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (funcall (inline (gnus-get-function gnus-command-method 'server-opened))
+ (nth 1 gnus-command-method)))
+
+(defun gnus-status-message (gnus-command-method)
+ "Return the status message from GNUS-COMMAND-METHOD.
+If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method
+this group uses will be queried."
+ (let ((gnus-command-method
+ (if (stringp gnus-command-method)
+ (gnus-find-method-for-group gnus-command-method)
+ gnus-command-method)))
+ (funcall (gnus-get-function gnus-command-method 'status-message)
+ (nth 1 gnus-command-method))))
+
+(defun gnus-request-regenerate (gnus-command-method)
+ "Request a data generation from GNUS-COMMAND-METHOD."
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-regenerate)
+ (nth 1 gnus-command-method)))
+
+(defun gnus-request-group (group &optional dont-check gnus-command-method)
+ "Request GROUP. If DONT-CHECK, no information is required."
+ (let ((gnus-command-method
+ (or gnus-command-method (inline (gnus-find-method-for-group group)))))
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method
+ (inline (gnus-server-to-method gnus-command-method))))
+ (funcall (inline (gnus-get-function gnus-command-method 'request-group))
+ (gnus-group-real-name group) (nth 1 gnus-command-method)
+ dont-check)))
+
+(defun gnus-list-active-group (group)
+ "Request active information on GROUP."
+ (let ((gnus-command-method (gnus-find-method-for-group group))
+ (func 'list-active-group))
+ (when (gnus-check-backend-function func group)
+ (funcall (gnus-get-function gnus-command-method func)
+ (gnus-group-real-name group) (nth 1 gnus-command-method)))))
+
+(defun gnus-request-group-description (group)
+ "Request a description of GROUP."
+ (let ((gnus-command-method (gnus-find-method-for-group group))
+ (func 'request-group-description))
+ (when (gnus-check-backend-function func group)
+ (funcall (gnus-get-function gnus-command-method func)
+ (gnus-group-real-name group) (nth 1 gnus-command-method)))))
+
+(defun gnus-close-group (group)
+ "Request the GROUP be closed."
+ (let ((gnus-command-method (inline (gnus-find-method-for-group group))))
+ (funcall (gnus-get-function gnus-command-method 'close-group)
+ (gnus-group-real-name group) (nth 1 gnus-command-method))))
+
+(defun gnus-retrieve-headers (articles group &optional fetch-old)
+ "Request headers for ARTICLES in GROUP.
+If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (if (and gnus-use-cache (numberp (car articles)))
+ (gnus-cache-retrieve-headers articles group fetch-old)
+ (funcall (gnus-get-function gnus-command-method 'retrieve-headers)
+ articles (gnus-group-real-name group)
+ (nth 1 gnus-command-method) fetch-old))))
+
+(defun gnus-retrieve-articles (articles group)
+ "Request ARTICLES in GROUP."
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function gnus-command-method 'retrieve-articles)
+ articles (gnus-group-real-name group)
+ (nth 1 gnus-command-method))))
+
+(defun gnus-retrieve-groups (groups gnus-command-method)
+ "Request active information on GROUPS from GNUS-COMMAND-METHOD."
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (funcall (gnus-get-function gnus-command-method 'retrieve-groups)
+ groups (nth 1 gnus-command-method)))
+
+(defun gnus-request-type (group &optional article)
+ "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (if (not (gnus-check-backend-function
+ 'request-type (car gnus-command-method)))
+ 'unknown
+ (funcall (gnus-get-function gnus-command-method 'request-type)
+ (gnus-group-real-name group) article))))
+
+(defun gnus-request-update-mark (group article mark)
+ "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (if (not (gnus-check-backend-function
+ 'request-update-mark (car gnus-command-method)))
+ mark
+ (funcall (gnus-get-function gnus-command-method 'request-update-mark)
+ (gnus-group-real-name group) article mark))))
+
+(defun gnus-request-article (article group &optional buffer)
+ "Request the ARTICLE in GROUP.
+ARTICLE can either be an article number or an article Message-ID.
+If BUFFER, insert the article in that group."
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function gnus-command-method 'request-article)
+ article (gnus-group-real-name group)
+ (nth 1 gnus-command-method) buffer)))
+
+(defun gnus-request-head (article group)
+ "Request the head of ARTICLE in GROUP."
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (head (gnus-get-function gnus-command-method 'request-head t))
+ res clean-up)
+ (cond
+ ;; Check the cache.
+ ((and gnus-use-cache
+ (numberp article)
+ (gnus-cache-request-article article group))
+ (setq res (cons group article)
+ clean-up t))
+ ;; Use `head' function.
+ ((fboundp head)
+ (setq res (funcall head article (gnus-group-real-name group)
+ (nth 1 gnus-command-method))))
+ ;; Use `article' function.
+ (t
+ (setq res (gnus-request-article article group)
+ clean-up t)))
+ (when clean-up
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (1- (point)) (point-max)))
+ (nnheader-fold-continuation-lines)))
+ res))
+
+(defun gnus-request-body (article group)
+ "Request the body of ARTICLE in GROUP."
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function gnus-command-method 'request-body)
+ article (gnus-group-real-name group)
+ (nth 1 gnus-command-method))))
+
+(defun gnus-request-post (gnus-command-method)
+ "Post the current buffer using GNUS-COMMAND-METHOD."
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-post)
+ (nth 1 gnus-command-method)))
+
+(defun gnus-request-scan (group gnus-command-method)
+ "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD.
+If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
+ (let ((gnus-command-method
+ (if group (gnus-find-method-for-group group) gnus-command-method))
+ (gnus-inhibit-demon t))
+ (funcall (gnus-get-function gnus-command-method 'request-scan)
+ (and group (gnus-group-real-name group))
+ (nth 1 gnus-command-method))))
+
+(defsubst gnus-request-update-info (info gnus-command-method)
+ "Request that GNUS-COMMAND-METHOD update INFO."
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (when (gnus-check-backend-function
+ 'request-update-info (car gnus-command-method))
+ (funcall (gnus-get-function gnus-command-method 'request-update-info)
+ (gnus-group-real-name (gnus-info-group info))
+ info (nth 1 gnus-command-method))))
+
+(defun gnus-request-expire-articles (articles group &optional force)
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function gnus-command-method 'request-expire-articles)
+ articles (gnus-group-real-name group) (nth 1 gnus-command-method)
+ force)))
+
+(defun gnus-request-move-article
+ (article group server accept-function &optional last)
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function gnus-command-method 'request-move-article)
+ article (gnus-group-real-name group)
+ (nth 1 gnus-command-method) accept-function last)))
+
+(defun gnus-request-accept-article (group &optional gnus-command-method last)
+ ;; Make sure there's a newline at the end of the article.
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (when (and (not gnus-command-method)
+ (stringp group))
+ (setq gnus-command-method (gnus-group-name-to-method group)))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (let ((func (car (or gnus-command-method
+ (gnus-find-method-for-group group)))))
+ (funcall (intern (format "%s-request-accept-article" func))
+ (if (stringp group) (gnus-group-real-name group) group)
+ (cadr gnus-command-method)
+ last)))
+
+(defun gnus-request-replace-article (article group buffer)
+ (let ((func (car (gnus-group-name-to-method group))))
+ (funcall (intern (format "%s-request-replace-article" func))
+ article (gnus-group-real-name group) buffer)))
+
+(defun gnus-request-associate-buffer (group)
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function gnus-command-method 'request-associate-buffer)
+ (gnus-group-real-name group))))
+
+(defun gnus-request-restore-buffer (article group)
+ "Request a new buffer restored to the state of ARTICLE."
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function gnus-command-method 'request-restore-buffer)
+ article (gnus-group-real-name group)
+ (nth 1 gnus-command-method))))
+
+(defun gnus-request-create-group (group &optional gnus-command-method args)
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (let ((gnus-command-method
+ (or gnus-command-method (gnus-find-method-for-group group))))
+ (funcall (gnus-get-function gnus-command-method 'request-create-group)
+ (gnus-group-real-name group) (nth 1 gnus-command-method) args)))
+
+(defun gnus-request-delete-group (group &optional force)
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function gnus-command-method 'request-delete-group)
+ (gnus-group-real-name group) force (nth 1 gnus-command-method))))
+
+(defun gnus-request-rename-group (group new-name)
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function gnus-command-method 'request-rename-group)
+ (gnus-group-real-name group)
+ (gnus-group-real-name new-name) (nth 1 gnus-command-method))))
+
+(defun gnus-close-backends ()
+ ;; Send a close request to all backends that support such a request.
+ (let ((methods gnus-valid-select-methods)
+ (gnus-inhibit-demon t)
+ func gnus-command-method)
+ (while (setq gnus-command-method (pop methods))
+ (when (fboundp (setq func (intern
+ (concat (car gnus-command-method)
+ "-request-close"))))
+ (funcall func)))))
+
+(defun gnus-asynchronous-p (gnus-command-method)
+ (let ((func (gnus-get-function gnus-command-method 'asynchronous-p t)))
+ (when (fboundp func)
+ (funcall func))))
+
+(defun gnus-remove-denial (gnus-command-method)
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (let* ((elem (assoc gnus-command-method gnus-opened-servers))
+ (status (cadr elem)))
+ ;; If this hasn't been opened before, we add it to the list.
+ (when (eq status 'denied)
+ ;; Set the status of this server.
+ (setcar (cdr elem) 'closed))))
+
+(provide 'gnus-int)
+
+;;; gnus-int.el ends here
--- /dev/null
+;;; gnus-kill.el --- kill commands for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-art)
+(require 'gnus-range)
+
+(defcustom gnus-kill-file-mode-hook nil
+ "Hook for Gnus kill file mode."
+ :group 'gnus-score-kill
+ :type 'hook)
+
+(defcustom gnus-kill-expiry-days 7
+ "*Number of days before expiring unused kill file entries."
+ :group 'gnus-score-kill
+ :group 'gnus-score-expire
+ :type 'integer)
+
+(defcustom gnus-kill-save-kill-file nil
+ "*If non-nil, will save kill files after processing them."
+ :group 'gnus-score-kill
+ :type 'boolean)
+
+(defcustom gnus-winconf-kill-file nil
+ "What does this do, Lars?"
+ :group 'gnus-score-kill
+ :type 'sexp)
+
+(defcustom gnus-kill-killed t
+ "*If non-nil, Gnus will apply kill files to already killed articles.
+If it is nil, Gnus will never apply kill files to articles that have
+already been through the scoring process, which might very well save lots
+of time."
+ :group 'gnus-score-kill
+ :type 'boolean)
+
+\f
+
+(defmacro gnus-raise (field expression level)
+ `(gnus-kill ,field ,expression
+ (function (gnus-summary-raise-score ,level)) t))
+
+(defmacro gnus-lower (field expression level)
+ `(gnus-kill ,field ,expression
+ (function (gnus-summary-raise-score (- ,level))) t))
+
+;;;
+;;; Gnus Kill File Mode
+;;;
+
+(defvar gnus-kill-file-mode-map nil)
+
+(unless gnus-kill-file-mode-map
+ (gnus-define-keymap (setq gnus-kill-file-mode-map
+ (copy-keymap emacs-lisp-mode-map))
+ "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
+ "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
+ "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
+ "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
+ "\C-c\C-a" gnus-kill-file-apply-buffer
+ "\C-c\C-e" gnus-kill-file-apply-last-sexp
+ "\C-c\C-c" gnus-kill-file-exit))
+
+(defun gnus-kill-file-mode ()
+ "Major mode for editing kill files.
+
+If you are using this mode - you probably shouldn't. Kill files
+perform badly and paint with a pretty broad brush. Score files, on
+the other hand, are vastly faster (40x speedup) and give you more
+control over what to do.
+
+In addition to Emacs-Lisp Mode, the following commands are available:
+
+\\{gnus-kill-file-mode-map}
+
+ A kill file contains Lisp expressions to be applied to a selected
+newsgroup. The purpose is to mark articles as read on the basis of
+some set of regexps. A global kill file is applied to every newsgroup,
+and a local kill file is applied to a specified newsgroup. Since a
+global kill file is applied to every newsgroup, for better performance
+use a local one.
+
+ A kill file can contain any kind of Emacs Lisp expressions expected
+to be evaluated in the Summary buffer. Writing Lisp programs for this
+purpose is not so easy because the internal working of Gnus must be
+well-known. For this reason, Gnus provides a general function which
+does this easily for non-Lisp programmers.
+
+ The `gnus-kill' function executes commands available in Summary Mode
+by their key sequences. `gnus-kill' should be called with FIELD,
+REGEXP and optional COMMAND and ALL. FIELD is a string representing
+the header field or an empty string. If FIELD is an empty string, the
+entire article body is searched for. REGEXP is a string which is
+compared with FIELD value. COMMAND is a string representing a valid
+key sequence in Summary mode or Lisp expression. COMMAND defaults to
+'(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is
+executed in the Summary buffer. If the second optional argument ALL
+is non-nil, the COMMAND is applied to articles which are already
+marked as read or unread. Articles which are marked are skipped over
+by default.
+
+ For example, if you want to mark articles of which subjects contain
+the string `AI' as read, a possible kill file may look like:
+
+ (gnus-kill \"Subject\" \"AI\")
+
+ If you want to mark articles with `D' instead of `X', you can use
+the following expression:
+
+ (gnus-kill \"Subject\" \"AI\" \"d\")
+
+In this example it is assumed that the command
+`gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode.
+
+ It is possible to delete unnecessary headers which are marked with
+`X' in a kill file as follows:
+
+ (gnus-expunge \"X\")
+
+ If the Summary buffer is empty after applying kill files, Gnus will
+exit the selected newsgroup normally. If headers which are marked
+with `D' are deleted in a kill file, it is impossible to read articles
+which are marked as read in the previous Gnus sessions. Marks other
+than `D' should be used for articles which should really be deleted.
+
+Entry to this mode calls emacs-lisp-mode-hook and
+gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map gnus-kill-file-mode-map)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
+ (setq major-mode 'gnus-kill-file-mode)
+ (setq mode-name "Kill")
+ (lisp-mode-variables nil)
+ (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
+
+(defun gnus-kill-file-edit-file (newsgroup)
+ "Begin editing a kill file for NEWSGROUP.
+If NEWSGROUP is nil, the global kill file is selected."
+ (interactive "sNewsgroup: ")
+ (let ((file (gnus-newsgroup-kill-file newsgroup)))
+ (gnus-make-directory (file-name-directory file))
+ ;; Save current window configuration if this is first invocation.
+ (or (and (get-file-buffer file)
+ (get-buffer-window (get-file-buffer file)))
+ (setq gnus-winconf-kill-file (current-window-configuration)))
+ ;; Hack windows.
+ (let ((buffer (find-file-noselect file)))
+ (cond ((get-buffer-window buffer)
+ (pop-to-buffer buffer))
+ ((eq major-mode 'gnus-group-mode)
+ (gnus-configure-windows 'group) ;Take all windows.
+ (pop-to-buffer buffer))
+ ((eq major-mode 'gnus-summary-mode)
+ (gnus-configure-windows 'article)
+ (pop-to-buffer gnus-article-buffer)
+ (bury-buffer gnus-article-buffer)
+ (switch-to-buffer buffer))
+ (t ;No good rules.
+ (find-file-other-window file))))
+ (gnus-kill-file-mode)))
+
+;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
+(defun gnus-kill-set-kill-buffer ()
+ (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))
+ (buffer (find-file-noselect file)))
+ (set-buffer buffer)
+ (gnus-kill-file-mode)
+ (bury-buffer buffer)))
+
+(defun gnus-kill-file-enter-kill (field regexp &optional dont-move)
+ ;; Enter kill file entry.
+ ;; FIELD: String containing the name of the header field to kill.
+ ;; REGEXP: The string to kill.
+ (save-excursion
+ (let (string)
+ (unless (eq major-mode 'gnus-kill-file-mode)
+ (gnus-kill-set-kill-buffer))
+ (unless dont-move
+ (goto-char (point-max)))
+ (insert (setq string (format "(gnus-kill %S %S)\n" field regexp)))
+ (gnus-kill-file-apply-string string))))
+
+(defun gnus-kill-file-kill-by-subject ()
+ "Kill by subject."
+ (interactive)
+ (gnus-kill-file-enter-kill
+ "Subject"
+ (if (vectorp gnus-current-headers)
+ (regexp-quote
+ (gnus-simplify-subject (mail-header-subject gnus-current-headers)))
+ "")
+ t))
+
+(defun gnus-kill-file-kill-by-author ()
+ "Kill by author."
+ (interactive)
+ (gnus-kill-file-enter-kill
+ "From"
+ (if (vectorp gnus-current-headers)
+ (regexp-quote (mail-header-from gnus-current-headers))
+ "") t))
+
+(defun gnus-kill-file-kill-by-thread ()
+ "Kill by author."
+ (interactive)
+ (gnus-kill-file-enter-kill
+ "References"
+ (if (vectorp gnus-current-headers)
+ (regexp-quote (mail-header-id gnus-current-headers))
+ "")))
+
+(defun gnus-kill-file-kill-by-xref ()
+ "Kill by Xref."
+ (interactive)
+ (let ((xref (and (vectorp gnus-current-headers)
+ (mail-header-xref gnus-current-headers)))
+ (start 0)
+ group)
+ (if xref
+ (while (string-match " \\([^ \t]+\\):" xref start)
+ (setq start (match-end 0))
+ (when (not (string=
+ (setq group
+ (substring xref (match-beginning 1) (match-end 1)))
+ gnus-newsgroup-name))
+ (gnus-kill-file-enter-kill
+ "Xref" (concat " " (regexp-quote group) ":") t)))
+ (gnus-kill-file-enter-kill "Xref" "" t))))
+
+(defun gnus-kill-file-raise-followups-to-author (level)
+ "Raise score for all followups to the current author."
+ (interactive "p")
+ (let ((name (mail-header-from gnus-current-headers))
+ string)
+ (save-excursion
+ (gnus-kill-set-kill-buffer)
+ (goto-char (point-min))
+ (setq name (read-string (concat "Add " level
+ " to followup articles to: ")
+ (regexp-quote name)))
+ (setq
+ string
+ (format
+ "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
+ "From" name level))
+ (insert string)
+ (gnus-kill-file-apply-string string))
+ (gnus-message
+ 6 "Added temporary score file entry for followups to %s." name)))
+
+(defun gnus-kill-file-apply-buffer ()
+ "Apply current buffer to current newsgroup."
+ (interactive)
+ (if (and gnus-current-kill-article
+ (get-buffer gnus-summary-buffer))
+ ;; Assume newsgroup is selected.
+ (gnus-kill-file-apply-string (buffer-string))
+ (ding) (gnus-message 2 "No newsgroup is selected.")))
+
+(defun gnus-kill-file-apply-string (string)
+ "Apply STRING to current newsgroup."
+ (interactive)
+ (let ((string (concat "(progn \n" string "\n)")))
+ (save-excursion
+ (save-window-excursion
+ (pop-to-buffer gnus-summary-buffer)
+ (eval (car (read-from-string string)))))))
+
+(defun gnus-kill-file-apply-last-sexp ()
+ "Apply sexp before point in current buffer to current newsgroup."
+ (interactive)
+ (if (and gnus-current-kill-article
+ (get-buffer gnus-summary-buffer))
+ ;; Assume newsgroup is selected.
+ (let ((string
+ (buffer-substring
+ (save-excursion (forward-sexp -1) (point)) (point))))
+ (save-excursion
+ (save-window-excursion
+ (pop-to-buffer gnus-summary-buffer)
+ (eval (car (read-from-string string))))))
+ (ding) (gnus-message 2 "No newsgroup is selected.")))
+
+(defun gnus-kill-file-exit ()
+ "Save a kill file, then return to the previous buffer."
+ (interactive)
+ (save-buffer)
+ (let ((killbuf (current-buffer)))
+ ;; We don't want to return to article buffer.
+ (when (get-buffer gnus-article-buffer)
+ (bury-buffer gnus-article-buffer))
+ ;; Delete the KILL file windows.
+ (delete-windows-on killbuf)
+ ;; Restore last window configuration if available.
+ (when gnus-winconf-kill-file
+ (set-window-configuration gnus-winconf-kill-file))
+ (setq gnus-winconf-kill-file nil)
+ ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu.
+ (kill-buffer killbuf)))
+
+;; For kill files
+
+(defun gnus-Newsgroup-kill-file (newsgroup)
+ "Return the name of a kill file for NEWSGROUP.
+If NEWSGROUP is nil, return the global kill file instead."
+ (cond ((or (null newsgroup)
+ (string-equal newsgroup ""))
+ ;; The global kill file is placed at top of the directory.
+ (expand-file-name gnus-kill-file-name gnus-kill-files-directory))
+ (gnus-use-long-file-name
+ ;; Append ".KILL" to capitalized newsgroup name.
+ (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
+ "." gnus-kill-file-name)
+ gnus-kill-files-directory))
+ (t
+ ;; Place "KILL" under the hierarchical directory.
+ (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
+ "/" gnus-kill-file-name)
+ gnus-kill-files-directory))))
+
+(defun gnus-expunge (marks)
+ "Remove lines marked with MARKS."
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-limit-to-marks marks 'reverse)))
+
+(defun gnus-apply-kill-file-unless-scored ()
+ "Apply .KILL file, unless a .SCORE file for the same newsgroup exists."
+ (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name))
+ ;; Ignores global KILL.
+ (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
+ (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE"
+ gnus-newsgroup-name))
+ 0)
+ ((or (file-exists-p (gnus-newsgroup-kill-file nil))
+ (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
+ (gnus-apply-kill-file-internal))
+ (t
+ 0)))
+
+(defun gnus-apply-kill-file-internal ()
+ "Apply a kill file to the current newsgroup.
+Returns the number of articles marked as read."
+ (let* ((kill-files (list (gnus-newsgroup-kill-file nil)
+ (gnus-newsgroup-kill-file gnus-newsgroup-name)))
+ (unreads (length gnus-newsgroup-unreads))
+ (gnus-summary-inhibit-highlight t)
+ beg)
+ (setq gnus-newsgroup-kill-headers nil)
+ ;; If there are any previously scored articles, we remove these
+ ;; from the `gnus-newsgroup-headers' list that the score functions
+ ;; will see. This is probably pretty wasteful when it comes to
+ ;; conses, but is, I think, faster than having to assq in every
+ ;; single score function.
+ (let ((files kill-files))
+ (while files
+ (if (file-exists-p (car files))
+ (let ((headers gnus-newsgroup-headers))
+ (if gnus-kill-killed
+ (setq gnus-newsgroup-kill-headers
+ (mapcar (lambda (header) (mail-header-number header))
+ headers))
+ (while headers
+ (unless (gnus-member-of-range
+ (mail-header-number (car headers))
+ gnus-newsgroup-killed)
+ (push (mail-header-number (car headers))
+ gnus-newsgroup-kill-headers))
+ (setq headers (cdr headers))))
+ (setq files nil))
+ (setq files (cdr files)))))
+ (if (not gnus-newsgroup-kill-headers)
+ ()
+ (save-window-excursion
+ (save-excursion
+ (while kill-files
+ (if (not (file-exists-p (car kill-files)))
+ ()
+ (gnus-message 6 "Processing kill file %s..." (car kill-files))
+ (find-file (car kill-files))
+ (gnus-add-current-to-buffer-list)
+ (goto-char (point-min))
+
+ (if (consp (ignore-errors (read (current-buffer))))
+ (gnus-kill-parse-gnus-kill-file)
+ (gnus-kill-parse-rn-kill-file))
+
+ (gnus-message
+ 6 "Processing kill file %s...done" (car kill-files)))
+ (setq kill-files (cdr kill-files)))))
+
+ (gnus-set-mode-line 'summary)
+
+ (if beg
+ (let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
+ (or (eq nunreads 0)
+ (gnus-message 6 "Marked %d articles as read" nunreads))
+ nunreads)
+ 0))))
+
+;; Parse a Gnus killfile.
+(defun gnus-score-insert-help (string alist idx)
+ (save-excursion
+ (pop-to-buffer "*Score Help*")
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert string ":\n\n")
+ (while alist
+ (insert (format " %c: %s\n" (caar alist) (nth idx (car alist))))
+ (setq alist (cdr alist)))))
+
+(defun gnus-kill-parse-gnus-kill-file ()
+ (goto-char (point-min))
+ (gnus-kill-file-mode)
+ (let (beg form)
+ (while (progn
+ (setq beg (point))
+ (setq form (ignore-errors (read (current-buffer)))))
+ (unless (listp form)
+ (error "Illegal kill entry (possibly rn kill file?): %s" form))
+ (if (or (eq (car form) 'gnus-kill)
+ (eq (car form) 'gnus-raise)
+ (eq (car form) 'gnus-lower))
+ (progn
+ (delete-region beg (point))
+ (insert (or (eval form) "")))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (ignore-errors (eval form)))))
+ (and (buffer-modified-p)
+ gnus-kill-save-kill-file
+ (save-buffer))
+ (set-buffer-modified-p nil)))
+
+;; Parse an rn killfile.
+(defun gnus-kill-parse-rn-kill-file ()
+ (goto-char (point-min))
+ (gnus-kill-file-mode)
+ (let ((mod-to-header
+ '((?a . "")
+ (?h . "")
+ (?f . "from")
+ (?: . "subject")))
+ (com-to-com
+ '((?m . " ")
+ (?j . "X")))
+ pattern modifier commands)
+ (while (not (eobp))
+ (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)"))
+ ()
+ (setq pattern (buffer-substring (match-beginning 1) (match-end 1)))
+ (setq modifier (if (match-beginning 2) (char-after (match-beginning 2))
+ ?s))
+ (setq commands (buffer-substring (match-beginning 3) (match-end 3)))
+
+ ;; The "f:+" command marks everything *but* the matches as read,
+ ;; so we simply first match everything as read, and then unmark
+ ;; PATTERN later.
+ (when (string-match "\\+" commands)
+ (gnus-kill "from" ".")
+ (setq commands "m"))
+
+ (gnus-kill
+ (or (cdr (assq modifier mod-to-header)) "subject")
+ pattern
+ (if (string-match "m" commands)
+ '(gnus-summary-mark-as-unread nil " ")
+ '(gnus-summary-mark-as-read nil "X"))
+ nil t))
+ (forward-line 1))))
+
+;; Kill changes and new format by suggested by JWZ and Sudish Joseph
+;; <joseph@cis.ohio-state.edu>.
+(defun gnus-kill (field regexp &optional exe-command all silent)
+ "If FIELD of an article matches REGEXP, execute COMMAND.
+Optional 1st argument COMMAND is default to
+ (gnus-summary-mark-as-read nil \"X\").
+If optional 2nd argument ALL is non-nil, articles marked are also applied to.
+If FIELD is an empty string (or nil), entire article body is searched for.
+COMMAND must be a lisp expression or a string representing a key sequence."
+ ;; We don't want to change current point nor window configuration.
+ (let ((old-buffer (current-buffer)))
+ (save-excursion
+ (save-window-excursion
+ ;; Selected window must be summary buffer to execute keyboard
+ ;; macros correctly. See command_loop_1.
+ (switch-to-buffer gnus-summary-buffer 'norecord)
+ (goto-char (point-min)) ;From the beginning.
+ (let ((kill-list regexp)
+ (date (current-time-string))
+ (command (or exe-command '(gnus-summary-mark-as-read
+ nil gnus-kill-file-mark)))
+ kill kdate prev)
+ (if (listp kill-list)
+ ;; It is a list.
+ (if (not (consp (cdr kill-list)))
+ ;; It's on the form (regexp . date).
+ (if (zerop (gnus-execute field (car kill-list)
+ command nil (not all)))
+ (when (> (gnus-days-between date (cdr kill-list))
+ gnus-kill-expiry-days)
+ (setq regexp nil))
+ (setcdr kill-list date))
+ (while (setq kill (car kill-list))
+ (if (consp kill)
+ ;; It's a temporary kill.
+ (progn
+ (setq kdate (cdr kill))
+ (if (zerop (gnus-execute
+ field (car kill) command nil (not all)))
+ (when (> (gnus-days-between date kdate)
+ gnus-kill-expiry-days)
+ ;; Time limit has been exceeded, so we
+ ;; remove the match.
+ (if prev
+ (setcdr prev (cdr kill-list))
+ (setq regexp (cdr regexp))))
+ ;; Successful kill. Set the date to today.
+ (setcdr kill date)))
+ ;; It's a permanent kill.
+ (gnus-execute field kill command nil (not all)))
+ (setq prev kill-list)
+ (setq kill-list (cdr kill-list))))
+ (gnus-execute field kill-list command nil (not all))))))
+ (switch-to-buffer old-buffer)
+ (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
+ (gnus-pp-gnus-kill
+ (nconc (list 'gnus-kill field
+ (if (consp regexp) (list 'quote regexp) regexp))
+ (when (or exe-command all)
+ (list (list 'quote exe-command)))
+ (if all (list t) nil))))))
+
+(defun gnus-pp-gnus-kill (object)
+ (if (or (not (consp (nth 2 object)))
+ (not (consp (cdr (nth 2 object))))
+ (and (eq 'quote (car (nth 2 object)))
+ (not (consp (cdadr (nth 2 object))))))
+ (concat "\n" (gnus-prin1-to-string object))
+ (save-excursion
+ (set-buffer (get-buffer-create "*Gnus PP*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object)))
+ (let ((klist (cadr (nth 2 object)))
+ (first t))
+ (while klist
+ (insert (if first (progn (setq first nil) "") "\n ")
+ (gnus-prin1-to-string (car klist)))
+ (setq klist (cdr klist))))
+ (insert ")")
+ (and (nth 3 object)
+ (insert "\n "
+ (if (and (consp (nth 3 object))
+ (not (eq 'quote (car (nth 3 object)))))
+ "'" "")
+ (gnus-prin1-to-string (nth 3 object))))
+ (when (nth 4 object)
+ (insert "\n t"))
+ (insert ")")
+ (prog1
+ (buffer-substring (point-min) (point-max))
+ (kill-buffer (current-buffer))))))
+
+(defun gnus-execute-1 (function regexp form header)
+ (save-excursion
+ (let (did-kill)
+ (if (null header)
+ nil ;Nothing to do.
+ (if function
+ ;; Compare with header field.
+ (let (value)
+ (and header
+ (progn
+ (setq value (funcall function header))
+ ;; Number (Lines:) or symbol must be converted to string.
+ (unless (stringp value)
+ (setq value (gnus-prin1-to-string value)))
+ (setq did-kill (string-match regexp value)))
+ (cond ((stringp form) ;Keyboard macro.
+ (execute-kbd-macro form))
+ ((gnus-functionp form)
+ (funcall form))
+ (t
+ (eval form)))))
+ ;; Search article body.
+ (let ((gnus-current-article nil) ;Save article pointer.
+ (gnus-last-article nil)
+ (gnus-break-pages nil) ;No need to break pages.
+ (gnus-mark-article-hook nil)) ;Inhibit marking as read.
+ (gnus-message
+ 6 "Searching for article: %d..." (mail-header-number header))
+ (gnus-article-setup-buffer)
+ (gnus-article-prepare (mail-header-number header) t)
+ (when (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char (point-min))
+ (setq did-kill (re-search-forward regexp nil t)))
+ (cond ((stringp form) ;Keyboard macro.
+ (execute-kbd-macro form))
+ ((gnus-functionp form)
+ (funcall form))
+ (t
+ (eval form)))))))
+ did-kill)))
+
+(defun gnus-execute (field regexp form &optional backward unread)
+ "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
+If FIELD is an empty string (or nil), entire article body is searched for.
+If optional 1st argument BACKWARD is non-nil, do backward instead.
+If optional 2nd argument UNREAD is non-nil, articles which are
+marked as read or ticked are ignored."
+ (save-excursion
+ (let ((killed-no 0)
+ function article header)
+ (cond
+ ;; Search body.
+ ((or (null field)
+ (string-equal field ""))
+ (setq function nil))
+ ;; Get access function of header field.
+ ((fboundp
+ (setq function
+ (intern-soft
+ (concat "mail-header-" (downcase field)))))
+ (setq function `(lambda (h) (,function h))))
+ ;; Signal error.
+ (t
+ (error "Unknown header field: \"%s\"" field)))
+ ;; Starting from the current article.
+ (while (or
+ ;; First article.
+ (and (not article)
+ (setq article (gnus-summary-article-number)))
+ ;; Find later articles.
+ (setq article
+ (gnus-summary-search-forward unread nil backward)))
+ (and (or (null gnus-newsgroup-kill-headers)
+ (memq article gnus-newsgroup-kill-headers))
+ (vectorp (setq header (gnus-summary-article-header article)))
+ (gnus-execute-1 function regexp form header)
+ (setq killed-no (1+ killed-no))))
+ ;; Return the number of killed articles.
+ killed-no)))
+
+;;;###autoload
+(defalias 'gnus-batch-kill 'gnus-batch-score)
+;;;###autoload
+(defun gnus-batch-score ()
+ "Run batched scoring.
+Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
+Newsgroups is a list of strings in Bnews format. If you want to score
+the comp hierarchy, you'd say \"comp.all\". If you would not like to
+score the alt hierarchy, you'd say \"!alt.all\"."
+ (interactive)
+ (let* ((gnus-newsrc-options-n
+ (gnus-newsrc-parse-options
+ (concat "options -n "
+ (mapconcat 'identity command-line-args-left " "))))
+ (gnus-expert-user t)
+ (nnmail-spool-file nil)
+ (gnus-use-dribble-file nil)
+ (gnus-batch-mode t)
+ group newsrc entry
+ ;; Disable verbose message.
+ gnus-novice-user gnus-large-newsgroup
+ gnus-options-subscribe gnus-auto-subscribed-groups
+ gnus-options-not-subscribe)
+ ;; Eat all arguments.
+ (setq command-line-args-left nil)
+ (gnus-slave)
+ ;; Apply kills to specified newsgroups in command line arguments.
+ (setq newsrc (cdr gnus-newsrc-alist))
+ (while (setq group (car (pop newsrc)))
+ (setq entry (gnus-gethash group gnus-newsrc-hashtb))
+ (when (and (<= (gnus-info-level (car newsrc)) gnus-level-subscribed)
+ (and (car entry)
+ (or (eq (car entry) t)
+ (not (zerop (car entry)))))
+ ;;(eq (gnus-matches-options-n group) 'subscribe)
+ )
+ (gnus-summary-read-group group nil t nil t)
+ (when (eq (current-buffer) (get-buffer gnus-summary-buffer))
+ (gnus-summary-exit))))
+ ;; Exit Emacs.
+ (switch-to-buffer gnus-group-buffer)
+ (gnus-group-save-newsrc)))
+
+(provide 'gnus-kill)
+
+;;; gnus-kill.el ends here
--- /dev/null
+;;; gnus-load.el --- automatically extracted custom dependencies
+;;
+;;; Code:
+
+(put 'nnmail 'custom-loads '("nnmail"))
+(put 'gnus-article-emphasis 'custom-loads '("gnus-art"))
+(put 'gnus-article-headers 'custom-loads '("gnus-sum" "gnus-art"))
+(put 'nnmail-procmail 'custom-loads '("nnmail"))
+(put 'gnus-score-kill 'custom-loads '("gnus-kill"))
+(put 'gnus-visual 'custom-loads '("smiley" "gnus" "gnus-picon" "gnus-art" "earcon"))
+(put 'gnus-score-expire 'custom-loads '("gnus-score" "gnus-kill"))
+(put 'gnus-summary-maneuvering 'custom-loads '("gnus-sum"))
+(put 'gnus-start 'custom-loads '("gnus" "gnus-util" "gnus-start" "gnus-int" "gnus-group"))
+(put 'gnus-extract-view 'custom-loads '("gnus-uu" "gnus-sum"))
+(put 'gnus-various 'custom-loads '("gnus-sum"))
+(put 'gnus-article-washing 'custom-loads '("gnus-art"))
+(put 'gnus-score-files 'custom-loads '("gnus-score"))
+(put 'message-news 'custom-loads '("message"))
+(put 'gnus-thread 'custom-loads '("gnus-sum"))
+(put 'languages 'custom-loads '("cus-edit"))
+(put 'development 'custom-loads '("cus-edit"))
+(put 'gnus-treading 'custom-loads '("gnus-sum"))
+(put 'nnmail-various 'custom-loads '("nnmail"))
+(put 'extensions 'custom-loads '("wid-edit"))
+(put 'message-various 'custom-loads '("message"))
+(put 'gnus-summary-exit 'custom-loads '("gnus-sum"))
+(put 'news 'custom-loads '("message" "gnus"))
+(put 'gnus 'custom-loads '("nnmail" "gnus" "gnus-win" "gnus-uu" "gnus-eform" "gnus-dup" "gnus-demon" "gnus-cache" "gnus-async" "gnus-art"))
+(put 'gnus-summary-visual 'custom-loads '("gnus-sum"))
+(put 'gnus-group-listing 'custom-loads '("gnus-group"))
+(put 'gnus-score 'custom-loads '("gnus" "gnus-nocem"))
+(put 'gnus-group-select 'custom-loads '("gnus-sum"))
+(put 'message-buffers 'custom-loads '("message"))
+(put 'gnus-threading 'custom-loads '("gnus-sum"))
+(put 'gnus-score-decay 'custom-loads '("gnus-score"))
+(put 'help 'custom-loads '("cus-edit"))
+(put 'gnus-nocem 'custom-loads '("gnus-nocem"))
+(put 'gnus-cite 'custom-loads '("gnus-cite"))
+(put 'gnus-demon 'custom-loads '("gnus-demon"))
+(put 'gnus-message 'custom-loads '("message"))
+(put 'gnus-score-default 'custom-loads '("gnus-sum" "gnus-score"))
+(put 'nnmail-duplicate 'custom-loads '("nnmail"))
+(put 'message-interface 'custom-loads '("message"))
+(put 'nnmail-files 'custom-loads '("nnmail"))
+(put 'gnus-edit-form 'custom-loads '("gnus-eform"))
+(put 'emacs 'custom-loads '("cus-edit"))
+(put 'gnus-summary-mail 'custom-loads '("gnus-sum"))
+(put 'gnus-topic 'custom-loads '("gnus-topic"))
+(put 'wp 'custom-loads '("cus-edit"))
+(put 'gnus-summary-choose 'custom-loads '("gnus-sum"))
+(put 'widget-browse 'custom-loads '("wid-browse"))
+(put 'external 'custom-loads '("cus-edit"))
+(put 'message-headers 'custom-loads '("message"))
+(put 'message-forwarding 'custom-loads '("message"))
+(put 'message-faces 'custom-loads '("message"))
+(put 'environment 'custom-loads '("cus-edit"))
+(put 'gnus-article-mime 'custom-loads '("gnus-sum" "gnus-art"))
+(put 'gnus-duplicate 'custom-loads '("gnus-dup"))
+(put 'nnmail-retrieve 'custom-loads '("nnmail"))
+(put 'widgets 'custom-loads '("wid-edit" "wid-browse"))
+(put 'earcon 'custom-loads '("earcon"))
+(put 'hypermedia 'custom-loads '("wid-edit"))
+(put 'gnus-group-levels 'custom-loads '("gnus-group"))
+(put 'gnus-summary-format 'custom-loads '("gnus-sum"))
+(put 'gnus-files 'custom-loads '("nnmail" "gnus"))
+(put 'gnus-windows 'custom-loads '("gnus-win"))
+(put 'gnus-article-buttons 'custom-loads '("gnus-art"))
+(put 'gnus-summary 'custom-loads '("gnus" "gnus-sum"))
+(put 'gnus-article-hiding 'custom-loads '("gnus-sum" "gnus-art"))
+(put 'gnus-group 'custom-loads '("gnus" "gnus-topic"))
+(put 'gnus-article-various 'custom-loads '("gnus-sum" "gnus-art"))
+(put 'gnus-summary-marks 'custom-loads '("gnus-sum"))
+(put 'gnus-article-saving 'custom-loads '("gnus-art"))
+(put 'nnmail-expire 'custom-loads '("nnmail"))
+(put 'message-mail 'custom-loads '("message"))
+(put 'faces 'custom-loads '("wid-edit" "cus-edit" "message" "gnus"))
+(put 'gnus-summary-various 'custom-loads '("gnus-sum"))
+(put 'applications 'custom-loads '("cus-edit"))
+(put 'gnus-extract-archive 'custom-loads '("gnus-uu"))
+(put 'message 'custom-loads '("message"))
+(put 'message-sending 'custom-loads '("message"))
+(put 'editing 'custom-loads '("cus-edit"))
+(put 'gnus-score-adapt 'custom-loads '("gnus-score"))
+(put 'message-insertion 'custom-loads '("message"))
+(put 'gnus-extract-post 'custom-loads '("gnus-uu"))
+(put 'mail 'custom-loads '("message" "gnus"))
+(put 'gnus-summary-sort 'custom-loads '("gnus-sum"))
+(put 'customize 'custom-loads '("wid-edit" "custom" "cus-face" "cus-edit"))
+(put 'nnmail-split 'custom-loads '("nnmail"))
+(put 'gnus-asynchronous 'custom-loads '("gnus-async"))
+(put 'gnus-article-highlight 'custom-loads '("gnus-art"))
+(put 'gnus-extract 'custom-loads '("gnus-uu"))
+(put 'gnus-article 'custom-loads '("gnus-cite" "gnus-art"))
+(put 'gnus-group-foreign 'custom-loads '("gnus-group"))
+(put 'programming 'custom-loads '("cus-edit"))
+(put 'nnmail-prepare 'custom-loads '("nnmail"))
+(put 'picons 'custom-loads '("gnus-picon"))
+(put 'gnus-article-signature 'custom-loads '("gnus-art"))
+(put 'gnus-group-various 'custom-loads '("gnus-group"))
+
+(provide 'gnus-load)
+
+;;; gnus-load.el ends here
--- /dev/null
+;;; gnus-logic.el --- advanced scoring code for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-score)
+(require 'gnus-util)
+
+;;; Internal variables.
+
+(defvar gnus-advanced-headers nil)
+
+;; To avoid having 8-bit characters in the source file.
+(defvar gnus-advanced-not (intern (format "%c" 172)))
+
+(defconst gnus-advanced-index
+ ;; Name to index alist.
+ '(("number" 0 gnus-advanced-integer)
+ ("subject" 1 gnus-advanced-string)
+ ("from" 2 gnus-advanced-string)
+ ("date" 3 gnus-advanced-date)
+ ("message-id" 4 gnus-advanced-string)
+ ("references" 5 gnus-advanced-string)
+ ("chars" 6 gnus-advanced-integer)
+ ("lines" 7 gnus-advanced-integer)
+ ("xref" 8 gnus-advanced-string)
+ ("head" nil gnus-advanced-body)
+ ("body" nil gnus-advanced-body)
+ ("all" nil gnus-advanced-body)))
+
+(eval-and-compile
+ (autoload 'parse-time-string "parse-time"))
+
+(defun gnus-score-advanced (rule &optional trace)
+ "Apply advanced scoring RULE to all the articles in the current group."
+ (let ((headers gnus-newsgroup-headers)
+ gnus-advanced-headers score)
+ (while (setq gnus-advanced-headers (pop headers))
+ (when (gnus-advanced-score-rule (car rule))
+ ;; This rule was successful, so we add the score to
+ ;; this article.
+ (if (setq score (assq (mail-header-number gnus-advanced-headers)
+ gnus-newsgroup-scored))
+ (setcdr score
+ (+ (cdr score)
+ (or (nth 1 rule)
+ gnus-score-interactive-default-score)))
+ (push (cons (mail-header-number gnus-advanced-headers)
+ (or (nth 1 rule)
+ gnus-score-interactive-default-score))
+ gnus-newsgroup-scored)
+ (when trace
+ (push (cons "A file" rule)
+ gnus-score-trace)))))))
+
+(defun gnus-advanced-score-rule (rule)
+ "Apply RULE to `gnus-advanced-headers'."
+ (let ((type (car rule)))
+ (cond
+ ;; "And" rule.
+ ((or (eq type '&) (eq type 'and))
+ (pop rule)
+ (if (not rule)
+ t ; Empty rule is true.
+ (while (and rule
+ (gnus-advanced-score-rule (car rule)))
+ (pop rule))
+ ;; If all the rules were true, then `rule' should be nil.
+ (not rule)))
+ ;; "Or" rule.
+ ((or (eq type '|) (eq type 'or))
+ (pop rule)
+ (if (not rule)
+ nil
+ (while (and rule
+ (not (gnus-advanced-score-rule (car rule))))
+ (pop rule))
+ ;; If one of the rules returned true, then `rule' should be non-nil.
+ rule))
+ ;; "Not" rule.
+ ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not))
+ (not (gnus-advanced-score-rule (nth 1 rule))))
+ ;; This is a `1-'-type redirection rule.
+ ((and (symbolp type)
+ (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type)))
+ (let ((gnus-advanced-headers
+ (gnus-parent-headers
+ gnus-advanced-headers
+ (if (string-match "^\\([0-9]+\\)-$" (symbol-name type))
+ ;; 1- type redirection.
+ (string-to-number
+ (substring (symbol-name type)
+ (match-beginning 0) (match-end 0)))
+ ;; ^^^ type redirection.
+ (length (symbol-name type))))))
+ (when gnus-advanced-headers
+ (gnus-advanced-score-rule (nth 1 rule)))))
+ ;; Plain scoring rule.
+ ((stringp type)
+ (gnus-advanced-score-article rule))
+ ;; Bug-out time!
+ (t
+ (error "Unknown advanced score type: %s" rule)))))
+
+(defun gnus-advanced-score-article (rule)
+ ;; `rule' is a semi-normal score rule, so we find out
+ ;; what function that's supposed to do the actual
+ ;; processing.
+ (let* ((header (car rule))
+ (func (assoc (downcase header) gnus-advanced-index)))
+ (if (not func)
+ (error "No such header: %s" rule)
+ ;; Call the score function.
+ (funcall (caddr func) (or (cadr func) header)
+ (cadr rule) (caddr rule)))))
+
+(defun gnus-advanced-string (index match type)
+ "See whether string MATCH of TYPE matches `gnus-advanced-headers' in INDEX."
+ (let* ((type (or type 's))
+ (case-fold-search (not (eq (downcase (symbol-name type))
+ (symbol-name type))))
+ (header (aref gnus-advanced-headers index)))
+ (cond
+ ((memq type '(r R regexp Regexp))
+ (string-match match header))
+ ((memq type '(s S string String))
+ (string-match (regexp-quote match) header))
+ ((memq type '(e E exact Exact))
+ (string= match header))
+ ((memq type '(f F fuzzy Fuzzy))
+ (string-match (regexp-quote (gnus-simplify-subject-fuzzy match))
+ header))
+ (t
+ (error "No such string match type: %s" type)))))
+
+(defun gnus-advanced-integer (index match type)
+ (if (not (memq type '(< > <= >= =)))
+ (error "No such integer score type: %s" type)
+ (funcall type match (or (aref gnus-advanced-headers index) 0))))
+
+(defun gnus-advanced-date (index match type)
+ (let ((date (encode-time (parse-time-string
+ (aref gnus-advanced-headers index))))
+ (match (encode-time (parse-time-string match))))
+ (cond
+ ((eq type 'at)
+ (equal date match))
+ ((eq type 'before)
+ (gnus-time-less match date))
+ ((eq type 'after)
+ (gnus-time-less date match))
+ (t
+ (error "No such date score type: %s" type)))))
+
+(defun gnus-advanced-body (header match type)
+ (when (string= header "all")
+ (setq header "article"))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let* ((request-func (cond ((string= "head" header)
+ 'gnus-request-head)
+ ((string= "body" header)
+ 'gnus-request-body)
+ (t 'gnus-request-article)))
+ ofunc article)
+ ;; Not all backends support partial fetching. In that case,
+ ;; we just fetch the entire article.
+ (unless (gnus-check-backend-function
+ (intern (concat "request-" header))
+ gnus-newsgroup-name)
+ (setq ofunc request-func)
+ (setq request-func 'gnus-request-article))
+ (setq article (mail-header-number gnus-advanced-headers))
+ (gnus-message 7 "Scoring article %s..." article)
+ (when (funcall request-func article gnus-newsgroup-name)
+ (goto-char (point-min))
+ ;; If just parts of the article is to be searched and the
+ ;; backend didn't support partial fetching, we just narrow
+ ;; to the relevant parts.
+ (when ofunc
+ (if (eq ofunc 'gnus-request-head)
+ (narrow-to-region
+ (point)
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (narrow-to-region
+ (or (search-forward "\n\n" nil t) (point))
+ (point-max))))
+ (let* ((case-fold-search (not (eq (downcase (symbol-name type))
+ (symbol-name type))))
+ (search-func
+ (cond ((memq type '(r R regexp Regexp))
+ 're-search-forward)
+ ((memq type '(s S string String))
+ 'search-forward)
+ (t
+ (error "Illegal match type: %s" type)))))
+ (goto-char (point-min))
+ (prog1
+ (funcall search-func match nil t)
+ (widen)))))))
+
+(provide 'gnus-logic)
+
+;;; gnus-logic.el ends here.
--- /dev/null
+;;; gnus-mh.el --- mh-e interface for Gnus
+;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Send mail using mh-e.
+
+;; The following mh-e interface is all cooperative works of
+;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP
+;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki
+;; SHINGU).
+
+;;; Code:
+
+(require 'gnus)
+(require 'mh-e)
+(require 'mh-comp)
+(require 'gnus-msg)
+(require 'gnus-sum)
+
+(defun gnus-summary-save-article-folder (&optional arg)
+ "Append the current article to an mh folder.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-folder))
+ (gnus-summary-save-article arg)))
+
+(defun gnus-summary-save-in-folder (&optional folder)
+ "Save this article to MH folder (using `rcvstore' in MH library).
+Optional argument FOLDER specifies folder name."
+ ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
+ (mh-find-path)
+ (let ((folder
+ (cond ((and (eq folder 'default)
+ gnus-newsgroup-last-folder)
+ gnus-newsgroup-last-folder)
+ (folder folder)
+ (t (mh-prompt-for-folder
+ "Save article in"
+ (funcall gnus-folder-save-name gnus-newsgroup-name
+ gnus-current-headers gnus-newsgroup-last-folder)
+ t))))
+ (errbuf (get-buffer-create " *Gnus rcvstore*"))
+ ;; Find the rcvstore program.
+ (exec-path (if mh-lib (cons mh-lib exec-path) exec-path)))
+ (gnus-eval-in-buffer-window gnus-original-article-buffer
+ (save-restriction
+ (widen)
+ (unwind-protect
+ (call-process-region
+ (point-min) (point-max) "rcvstore" nil errbuf nil folder)
+ (set-buffer errbuf)
+ (if (zerop (buffer-size))
+ (message "Article saved in folder: %s" folder)
+ (message "%s" (buffer-string)))
+ (kill-buffer errbuf))))
+ (setq gnus-newsgroup-last-folder folder)))
+
+(defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
+ "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
+If variable `gnus-use-long-file-name' is nil, it is +News.group.
+Otherwise, it is like +news/group."
+ (or last-folder
+ (concat "+"
+ (if gnus-use-long-file-name
+ (gnus-capitalize-newsgroup newsgroup)
+ (gnus-newsgroup-directory-form newsgroup)))))
+
+(defun gnus-folder-save-name (newsgroup headers &optional last-folder)
+ "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
+If variable `gnus-use-long-file-name' is nil, it is +news.group.
+Otherwise, it is like +news/group."
+ (or last-folder
+ (concat "+"
+ (if gnus-use-long-file-name
+ newsgroup
+ (gnus-newsgroup-directory-form newsgroup)))))
+
+(provide 'gnus-mh)
+
+;;; gnus-mh.el ends here
--- /dev/null
+;;; gnus-move.el --- commands for moving Gnus from one server to another
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-start)
+(require 'gnus-int)
+(require 'gnus-range)
+
+;;;
+;;; Moving by comparing Message-ID's.
+;;;
+
+;;;###autoload
+(defun gnus-change-server (from-server to-server)
+ "Move from FROM-SERVER to TO-SERVER.
+Update the .newsrc.eld file to reflect the change of nntp server."
+ (interactive
+ (list gnus-select-method (gnus-read-method "Move to method: ")))
+
+ ;; First start Gnus.
+ (let ((gnus-activate-level 0)
+ (nnmail-spool-file nil))
+ (gnus))
+
+ (save-excursion
+ ;; Go through all groups and translate.
+ (let ((newsrc gnus-newsrc-alist)
+ (nntp-nov-gap nil)
+ info)
+ (while (setq info (pop newsrc))
+ (when (gnus-group-native-p (gnus-info-group info))
+ (gnus-move-group-to-server info from-server to-server))))))
+
+(defun gnus-move-group-to-server (info from-server to-server)
+ "Move group INFO from FROM-SERVER to TO-SERVER."
+ (let ((group (gnus-info-group info))
+ to-active hashtb type mark marks
+ to-article to-reads to-marks article
+ act-articles)
+ (gnus-message 7 "Translating %s..." group)
+ (when (gnus-request-group group nil to-server)
+ (setq to-active (gnus-parse-active)
+ hashtb (gnus-make-hashtable 1024)
+ act-articles (gnus-uncompress-range to-active))
+ ;; Fetch the headers from the `to-server'.
+ (when (and to-active
+ act-articles
+ (setq type (gnus-retrieve-headers
+ act-articles
+ group to-server)))
+ ;; Convert HEAD headers. I don't care.
+ (when (eq type 'headers)
+ (nnvirtual-convert-headers))
+ ;; Create a mapping from Message-ID to article number.
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while (looking-at
+ "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
+ (gnus-sethash
+ (buffer-substring (match-beginning 1) (match-end 1))
+ (read (current-buffer))
+ hashtb)
+ (forward-line 1))
+ ;; Then we read the headers from the `from-server'.
+ (when (and (gnus-request-group group nil from-server)
+ (gnus-active group)
+ (setq type (gnus-retrieve-headers
+ (gnus-uncompress-range
+ (gnus-active group))
+ group from-server)))
+ ;; Make it easier to map marks.
+ (let ((mark-lists (gnus-info-marks info))
+ ms type m)
+ (while mark-lists
+ (setq type (caar mark-lists)
+ ms (gnus-uncompress-range (cdr (pop mark-lists))))
+ (while ms
+ (if (setq m (assq (car ms) marks))
+ (setcdr m (cons type (cdr m)))
+ (push (list (car ms) type) marks))
+ (pop ms))))
+ ;; Convert.
+ (when (eq type 'headers)
+ (nnvirtual-convert-headers))
+ ;; Go through the headers and map away.
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while (looking-at
+ "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
+ (setq to-article
+ (gnus-gethash
+ (buffer-substring (match-beginning 1) (match-end 1))
+ hashtb))
+ ;; Add this article to the list of read articles.
+ (push to-article to-reads)
+ ;; See if there are any marks and then add them.
+ (when (setq mark (assq (read (current-buffer)) marks))
+ (setq marks (delq mark marks))
+ (setcar mark to-article)
+ (push mark to-marks))
+ (forward-line 1))
+ ;; Now we know what the read articles are and what the
+ ;; article marks are. We transform the information
+ ;; into the Gnus info format.
+ (setq to-reads
+ (gnus-range-add
+ (gnus-compress-sequence (and to-reads (sort to-reads '<)) t)
+ (cons 1 (1- (car to-active)))))
+ (gnus-info-set-read info to-reads)
+ ;; Do the marks. I'm sure y'all understand what's
+ ;; going on down below, so I won't bother with any
+ ;; further comments. <duck>
+ (let ((mlists gnus-article-mark-lists)
+ lists ms a)
+ (while mlists
+ (push (list (cdr (pop mlists))) lists))
+ (while (setq ms (pop marks))
+ (setq article (pop ms))
+ (while ms
+ (setcdr (setq a (assq (pop ms) lists))
+ (cons article (cdr a)))))
+ (setq a lists)
+ (while a
+ (setcdr (car a) (gnus-compress-sequence
+ (and (cdar a) (sort (cdar a) '<))))
+ (pop a))
+ (gnus-info-set-marks info lists t)))))
+ (gnus-message 7 "Translating %s...done" group)))
+
+(defun gnus-group-move-group-to-server (info from-server to-server)
+ "Move the group on the current line from FROM-SERVER to TO-SERVER."
+ (interactive
+ (let ((info (gnus-get-info (gnus-group-group-name))))
+ (list info (gnus-find-method-for-group (gnus-info-group info))
+ (gnus-read-method (format "Move group %s to method: "
+ (gnus-info-group info))))))
+ (save-excursion
+ (gnus-move-group-to-server info from-server to-server)
+ ;; We have to update the group info to point use the right server.
+ (gnus-info-set-method info to-server t)
+ ;; We also have to change the name of the group and stuff.
+ (let* ((group (gnus-info-group info))
+ (new-name (gnus-group-prefixed-name
+ (gnus-group-real-name group) to-server)))
+ (gnus-info-set-group info new-name)
+ (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb)
+ gnus-newsrc-hashtb)
+ (gnus-sethash group nil gnus-newsrc-hashtb))))
+
+(provide 'gnus-move)
+
+;;; gnus-move.el ends here
--- /dev/null
+;;; gnus-msg.el --- mail and post interface for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-ems)
+(require 'message)
+(require 'gnus-art)
+
+;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
+(defvar gnus-post-method nil
+ "*Preferred method for posting USENET news.
+If this variable is nil, Gnus will use the current method to decide
+which method to use when posting. If it is non-nil, it will override
+the current method. This method will not be used in mail groups and
+the like, only in \"real\" newsgroups.
+
+The value must be a valid method as discussed in the documentation of
+`gnus-select-method'. It can also be a list of methods. If that is
+the case, the user will be queried for what select method to use when
+posting.")
+
+(defvar gnus-outgoing-message-group nil
+ "*All outgoing messages will be put in this group.
+If you want to store all your outgoing mail and articles in the group
+\"nnml:archive\", you set this variable to that value. This variable
+can also be a list of group names.
+
+If you want to have greater control over what group to put each
+message in, you can set this variable to a function that checks the
+current newsgroup name and then returns a suitable group name (or list
+of names).")
+
+(defvar gnus-mailing-list-groups nil
+ "*Regexp matching groups that are really mailing lists.
+This is useful when you're reading a mailing list that has been
+gatewayed to a newsgroup, and you want to followup to an article in
+the group.")
+
+(defvar gnus-add-to-list nil
+ "*If non-nil, add a `to-list' parameter automatically.")
+
+(defvar gnus-sent-message-ids-file
+ (nnheader-concat gnus-directory "Sent-Message-IDs")
+ "File where Gnus saves a cache of sent message ids.")
+
+(defvar gnus-sent-message-ids-length 1000
+ "The number of sent Message-IDs to save.")
+
+(defvar gnus-crosspost-complaint
+ "Hi,
+
+You posted the article below with the following Newsgroups header:
+
+Newsgroups: %s
+
+The %s group, at least, was an inappropriate recipient
+of this message. Please trim your Newsgroups header to exclude this
+group before posting in the future.
+
+Thank you.
+
+"
+ "Format string to be inserted when complaining about crossposts.
+The first %s will be replaced by the Newsgroups header;
+the second with the current group name.")
+
+(defvar gnus-message-setup-hook nil
+ "Hook run after setting up a message buffer.")
+
+;;; Internal variables.
+
+(defvar gnus-message-buffer "*Mail Gnus*")
+(defvar gnus-article-copy nil)
+(defvar gnus-last-posting-server nil)
+(defvar gnus-message-group-art nil)
+
+(defconst gnus-bug-message
+ "Sending a bug report to the Gnus Towers.
+========================================
+
+The buffer below is a mail buffer. When you press `C-c C-c', it will
+be sent to the Gnus Bug Exterminators.
+
+At the bottom of the buffer you'll see lots of variable settings.
+Please do not delete those. They will tell the Bug People what your
+environment is, so that it will be easier to locate the bugs.
+
+If you have found a bug that makes Emacs go \"beep\", set
+debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
+and include the backtrace in your bug report.
+
+Please describe the bug in annoying, painstaking detail.
+
+Thank you for your help in stamping out bugs.
+")
+
+(eval-and-compile
+ (autoload 'gnus-uu-post-news "gnus-uu" nil t)
+ (autoload 'news-setup "rnewspost")
+ (autoload 'news-reply-mode "rnewspost")
+ (autoload 'rmail-dont-reply-to "mail-utils")
+ (autoload 'rmail-output "rmailout"))
+
+\f
+;;;
+;;; Gnus Posting Functions
+;;;
+
+(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
+ "p" gnus-summary-post-news
+ "f" gnus-summary-followup
+ "F" gnus-summary-followup-with-original
+ "c" gnus-summary-cancel-article
+ "s" gnus-summary-supersede-article
+ "r" gnus-summary-reply
+ "R" gnus-summary-reply-with-original
+ "w" gnus-summary-wide-reply
+ "W" gnus-summary-wide-reply-with-original
+ "n" gnus-summary-followup-to-mail
+ "N" gnus-summary-followup-to-mail-with-original
+ "m" gnus-summary-mail-other-window
+ "u" gnus-uu-post-news
+ "\M-c" gnus-summary-mail-crosspost-complaint
+ "om" gnus-summary-mail-forward
+ "op" gnus-summary-post-forward
+ "Om" gnus-uu-digest-mail-forward
+ "Op" gnus-uu-digest-post-forward)
+
+(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
+ "b" gnus-summary-resend-bounced-mail
+ ;; "c" gnus-summary-send-draft
+ "r" gnus-summary-resend-message)
+
+;;; Internal functions.
+
+(defvar gnus-article-reply nil)
+(defmacro gnus-setup-message (config &rest forms)
+ (let ((winconf (make-symbol "gnus-setup-message-winconf"))
+ (buffer (make-symbol "gnus-setup-message-buffer"))
+ (article (make-symbol "gnus-setup-message-article")))
+ `(let ((,winconf (current-window-configuration))
+ (,buffer (buffer-name (current-buffer)))
+ (,article (and gnus-article-reply (gnus-summary-article-number)))
+ (message-header-setup-hook
+ (copy-sequence message-header-setup-hook)))
+ (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
+ (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
+ (unwind-protect
+ (progn
+ ,@forms)
+ (gnus-inews-add-send-actions ,winconf ,buffer ,article)
+ (setq gnus-message-buffer (current-buffer))
+ (set (make-local-variable 'gnus-message-group-art)
+ (cons ,gnus-newsgroup-name ,article))
+ (make-local-variable 'gnus-newsgroup-name)
+ (run-hooks 'gnus-message-setup-hook))
+ (gnus-configure-windows ,config t)
+ (set-buffer-modified-p nil))))
+
+(defun gnus-inews-add-send-actions (winconf buffer article)
+ (make-local-hook 'message-sent-hook)
+ (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
+ (setq message-post-method
+ `(lambda (arg)
+ (gnus-post-method arg ,gnus-newsgroup-name)))
+ (setq message-newsreader (setq message-mailer (gnus-extended-version)))
+ (message-add-action
+ `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
+ (message-add-action
+ `(when (buffer-name (get-buffer ,buffer))
+ (save-excursion
+ (set-buffer (get-buffer ,buffer))
+ ,(when article
+ `(gnus-summary-mark-article-as-replied ,article))))
+ 'send))
+
+(put 'gnus-setup-message 'lisp-indent-function 1)
+(put 'gnus-setup-message 'edebug-form-spec '(form body))
+
+;;; Post news commands of Gnus group mode and summary mode
+
+(defun gnus-group-mail ()
+ "Start composing a mail."
+ (interactive)
+ (gnus-setup-message 'message
+ (message-mail)))
+
+(defun gnus-group-post-news (&optional arg)
+ "Start composing a news message.
+If ARG, post to the group under point.
+If ARG is 1, prompt for a group name."
+ (interactive "P")
+ ;; Bind this variable here to make message mode hooks
+ ;; work ok.
+ (let ((gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Newsgroup: " gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ "")))
+ (gnus-post-news 'post gnus-newsgroup-name)))
+
+(defun gnus-summary-post-news ()
+ "Start composing a news message."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-post-news 'post gnus-newsgroup-name))
+
+(defun gnus-summary-followup (yank &optional force-news)
+ "Compose a followup to an article.
+If prefix argument YANK is non-nil, original article is yanked automatically."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnus-set-global-variables)
+ (when yank
+ (gnus-summary-goto-subject (car yank)))
+ (save-window-excursion
+ (gnus-summary-select-article))
+ (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
+ (gnus-newsgroup-name gnus-newsgroup-name))
+ ;; Send a followup.
+ (gnus-post-news nil gnus-newsgroup-name
+ headers gnus-article-buffer
+ yank nil force-news)))
+
+(defun gnus-summary-followup-with-original (n &optional force-news)
+ "Compose a followup to an article and include the original article."
+ (interactive "P")
+ (gnus-summary-followup (gnus-summary-work-articles n) force-news))
+
+(defun gnus-summary-followup-to-mail (&optional arg)
+ "Followup to the current mail message via news."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnus-summary-followup arg t))
+
+(defun gnus-summary-followup-to-mail-with-original (&optional arg)
+ "Followup to the current mail message via news."
+ (interactive "P")
+ (gnus-summary-followup (gnus-summary-work-articles arg) t))
+
+(defun gnus-inews-yank-articles (articles)
+ (let (beg article)
+ (message-goto-body)
+ (while (setq article (pop articles))
+ (save-window-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-select-article nil nil nil article)
+ (gnus-summary-remove-process-mark article))
+ (gnus-copy-article-buffer)
+ (let ((message-reply-buffer gnus-article-copy)
+ (message-reply-headers gnus-current-headers))
+ (message-yank-original)
+ (setq beg (or beg (mark t))))
+ (when articles
+ (insert "\n")))
+ (push-mark)
+ (goto-char beg)))
+
+(defun gnus-summary-cancel-article (n)
+ "Cancel an article you posted."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((articles (gnus-summary-work-articles n))
+ (message-post-method
+ `(lambda (arg)
+ (gnus-post-method nil ,gnus-newsgroup-name)))
+ article)
+ (while (setq article (pop articles))
+ (when (gnus-summary-select-article t nil nil article)
+ (when (gnus-eval-in-buffer-window gnus-original-article-buffer
+ (message-cancel-news))
+ (gnus-summary-mark-as-read article gnus-canceled-mark)
+ (gnus-cache-remove-article 1))
+ (gnus-article-hide-headers-if-wanted))
+ (gnus-summary-remove-process-mark article))))
+
+(defun gnus-summary-supersede-article ()
+ "Compose an article that will supersede a previous article.
+This is done simply by taking the old article and adding a Supersedes
+header line with the old Message-ID."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((article (gnus-summary-article-number)))
+ (gnus-setup-message 'reply-yank
+ (gnus-summary-select-article t)
+ (set-buffer gnus-original-article-buffer)
+ (message-supersede)
+ (push
+ `((lambda ()
+ (when (buffer-name (get-buffer ,gnus-summary-buffer))
+ (save-excursion
+ (set-buffer (get-buffer ,gnus-summary-buffer))
+ (gnus-cache-possibly-remove-article ,article nil nil nil t)
+ (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
+ message-send-actions))))
+
+\f
+
+(defun gnus-copy-article-buffer (&optional article-buffer)
+ ;; make a copy of the article buffer with all text properties removed
+ ;; this copy is in the buffer gnus-article-copy.
+ ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
+ ;; this buffer should be passed to all mail/news reply/post routines.
+ (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
+ (buffer-disable-undo gnus-article-copy)
+ (or (memq gnus-article-copy gnus-buffer-list)
+ (push gnus-article-copy gnus-buffer-list))
+ (let ((article-buffer (or article-buffer gnus-article-buffer))
+ end beg contents)
+ (if (not (and (get-buffer article-buffer)
+ (buffer-name (get-buffer article-buffer))))
+ (error "Can't find any article buffer")
+ (save-excursion
+ (set-buffer article-buffer)
+ (save-restriction
+ ;; Copy over the (displayed) article buffer, delete
+ ;; hidden text and remove text properties.
+ (widen)
+ (copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (set-buffer gnus-article-copy)
+ (gnus-article-delete-text-of-type 'annotation)
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)
+ (insert
+ (prog1
+ (format "%s" (buffer-string))
+ (erase-buffer)))
+ ;; Find the original headers.
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (while (looking-at message-unix-mail-delimiter)
+ (forward-line 1))
+ (setq beg (point))
+ (setq end (or (search-forward "\n\n" nil t) (point)))
+ ;; Delete the headers from the displayed articles.
+ (set-buffer gnus-article-copy)
+ (delete-region (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point)))
+ ;; Insert the original article headers.
+ (insert-buffer-substring gnus-original-article-buffer beg end)
+ (gnus-article-decode-rfc1522)))
+ gnus-article-copy)))
+
+(defun gnus-post-news (post &optional group header article-buffer yank subject
+ force-news)
+ (when article-buffer
+ (gnus-copy-article-buffer))
+ (let ((gnus-article-reply article-buffer)
+ (add-to-list gnus-add-to-list))
+ (gnus-setup-message (cond (yank 'reply-yank)
+ (article-buffer 'reply)
+ (t 'message))
+ (let* ((group (or group gnus-newsgroup-name))
+ (pgroup group)
+ to-address to-group mailing-list to-list
+ newsgroup-p)
+ (when group
+ (setq to-address (gnus-group-find-parameter group 'to-address)
+ to-group (gnus-group-find-parameter group 'to-group)
+ to-list (gnus-group-find-parameter group 'to-list)
+ newsgroup-p (gnus-group-find-parameter group 'newsgroup)
+ mailing-list (when gnus-mailing-list-groups
+ (string-match gnus-mailing-list-groups group))
+ group (gnus-group-real-name group)))
+ (if (or (and to-group
+ (gnus-news-group-p to-group))
+ newsgroup-p
+ force-news
+ (and (gnus-news-group-p
+ (or pgroup gnus-newsgroup-name)
+ (if header (mail-header-number header)
+ gnus-current-article))
+ (not mailing-list)
+ (not to-list)
+ (not to-address)))
+ ;; This is news.
+ (if post
+ (message-news (or to-group group))
+ (set-buffer gnus-article-copy)
+ (message-followup (if (or newsgroup-p force-news) nil to-group)))
+ ;; The is mail.
+ (if post
+ (progn
+ (message-mail (or to-address to-list))
+ ;; Arrange for mail groups that have no `to-address' to
+ ;; get that when the user sends off the mail.
+ (when (and (not to-list)
+ (not to-address)
+ add-to-list)
+ (push (list 'gnus-inews-add-to-address pgroup)
+ message-send-actions)))
+ (set-buffer gnus-article-copy)
+ (message-wide-reply to-address
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'broken-reply-to))))
+ (when yank
+ (gnus-inews-yank-articles yank))))))
+
+(defun gnus-post-method (arg group &optional silent)
+ "Return the posting method based on GROUP and ARG.
+If SILENT, don't prompt the user."
+ (let ((group-method (gnus-find-method-for-group group)))
+ (cond
+ ;; If the group-method is nil (which shouldn't happen) we use
+ ;; the default method.
+ ((null group-method)
+ (or gnus-post-method gnus-select-method message-post-method))
+ ;; We want this group's method.
+ ((and arg (not (eq arg 0)))
+ group-method)
+ ;; We query the user for a post method.
+ ((or arg
+ (and gnus-post-method
+ (listp (car gnus-post-method))))
+ (let* ((methods
+ ;; Collect all methods we know about.
+ (append
+ (when gnus-post-method
+ (if (listp (car gnus-post-method))
+ gnus-post-method
+ (list gnus-post-method)))
+ gnus-secondary-select-methods
+ (list gnus-select-method)
+ (list group-method)))
+ method-alist post-methods method)
+ ;; Weed out all mail methods.
+ (while methods
+ (setq method (gnus-server-get-method "" (pop methods)))
+ (when (or (gnus-method-option-p method 'post)
+ (gnus-method-option-p method 'post-mail))
+ (push method post-methods)))
+ ;; Create a name-method alist.
+ (setq method-alist
+ (mapcar
+ (lambda (m)
+ (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
+ post-methods))
+ ;; Query the user.
+ (cadr
+ (assoc
+ (setq gnus-last-posting-server
+ (if (and silent
+ gnus-last-posting-server)
+ ;; Just use the last value.
+ gnus-last-posting-server
+ (completing-read
+ "Posting method: " method-alist nil t
+ (cons (or gnus-last-posting-server "") 0))))
+ method-alist))))
+ ;; Override normal method.
+ (gnus-post-method
+ gnus-post-method)
+ ;; Use the normal select method.
+ (t gnus-select-method))))
+
+;;;
+;;; Check whether the message has been sent already.
+;;;
+
+(defvar gnus-inews-sent-ids nil)
+
+(defun gnus-inews-reject-message ()
+ "Check whether this message has already been sent."
+ (when gnus-sent-message-ids-file
+ (let ((message-id (save-restriction (message-narrow-to-headers)
+ (mail-fetch-field "message-id")))
+ end)
+ (when message-id
+ (unless gnus-inews-sent-ids
+ (ignore-errors
+ (load t t t)))
+ (if (member message-id gnus-inews-sent-ids)
+ ;; Reject this message.
+ (not (gnus-yes-or-no-p
+ (format "Message %s already sent. Send anyway? "
+ message-id)))
+ (push message-id gnus-inews-sent-ids)
+ ;; Chop off the last Message-IDs.
+ (when (setq end (nthcdr gnus-sent-message-ids-length
+ gnus-inews-sent-ids))
+ (setcdr end nil))
+ (nnheader-temp-write gnus-sent-message-ids-file
+ (gnus-prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids)))
+ nil)))))
+
+\f
+
+;; Dummy to avoid byte-compile warning.
+(defvar nnspool-rejected-article-hook)
+(defvar xemacs-codename)
+
+;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might
+;;; as well include the Emacs version as well.
+;;; The following function works with later GNU Emacs, and XEmacs.
+(defun gnus-extended-version ()
+ "Stringified Gnus version and Emacs version"
+ (interactive)
+ (concat
+ gnus-version
+ "/"
+ (cond
+ ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
+ (concat "Emacs " (substring emacs-version
+ (match-beginning 1)
+ (match-end 1))))
+ ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
+ emacs-version)
+ (concat (substring emacs-version
+ (match-beginning 1)
+ (match-end 1))
+ (format " %d.%d" emacs-major-version emacs-minor-version)
+ (if (match-beginning 3)
+ (substring emacs-version
+ (match-beginning 3)
+ (match-end 3))
+ "")
+ (if (boundp 'xemacs-codename)
+ (concat " - \"" xemacs-codename "\""))))
+ (t emacs-version))))
+
+;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
+(defun gnus-inews-insert-mime-headers ()
+ (goto-char (point-min))
+ (let ((mail-header-separator
+ (progn
+ (goto-char (point-min))
+ (if (and (search-forward (concat "\n" mail-header-separator "\n")
+ nil t)
+ (not (search-backward "\n\n" nil t)))
+ mail-header-separator
+ ""))))
+ (or (mail-position-on-field "Mime-Version")
+ (insert "1.0")
+ (cond ((save-restriction
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward "[\200-\377]" nil t))
+ (or (mail-position-on-field "Content-Type")
+ (insert "text/plain; charset=ISO-8859-1"))
+ (or (mail-position-on-field "Content-Transfer-Encoding")
+ (insert "8bit")))
+ (t (or (mail-position-on-field "Content-Type")
+ (insert "text/plain; charset=US-ASCII"))
+ (or (mail-position-on-field "Content-Transfer-Encoding")
+ (insert "7bit")))))))
+
+\f
+;;;
+;;; Gnus Mail Functions
+;;;
+
+;;; Mail reply commands of Gnus summary mode
+
+(defun gnus-summary-reply (&optional yank wide)
+ "Start composing a reply mail to the current message.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ ;; Stripping headers should be specified with mail-yank-ignored-headers.
+ (gnus-set-global-variables)
+ (when yank
+ (gnus-summary-goto-subject (car yank)))
+ (let ((gnus-article-reply t))
+ (gnus-setup-message (if yank 'reply-yank 'reply)
+ (gnus-summary-select-article)
+ (set-buffer (gnus-copy-article-buffer))
+ (message-reply nil wide (gnus-group-find-parameter
+ gnus-newsgroup-name 'broken-reply-to))
+ (when yank
+ (gnus-inews-yank-articles yank)))))
+
+(defun gnus-summary-reply-with-original (n &optional wide)
+ "Start composing a reply mail to the current message.
+The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply (gnus-summary-work-articles n) wide))
+
+(defun gnus-summary-wide-reply (&optional yank)
+ "Start composing a wide reply mail to the current message.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnus-summary-reply yank t))
+
+(defun gnus-summary-wide-reply-with-original (n)
+ "Start composing a wide reply mail to the current message.
+The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply-with-original n t))
+
+(defun gnus-summary-mail-forward (&optional full-headers post)
+ "Forward the current message to another user.
+If FULL-HEADERS (the prefix), include full headers when forwarding."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (set-buffer gnus-original-article-buffer)
+ (let ((message-included-forward-headers
+ (if full-headers "" message-included-forward-headers)))
+ (message-forward post))))
+
+(defun gnus-summary-resend-message (address n)
+ "Resend the current article to ADDRESS."
+ (interactive "sResend message(s) to: \nP")
+ (let ((articles (gnus-summary-work-articles n))
+ article)
+ (while (setq article (pop articles))
+ (gnus-summary-select-article nil nil nil article)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (message-resend address)))))
+
+(defun gnus-summary-post-forward (&optional full-headers)
+ "Forward the current article to a newsgroup.
+If FULL-HEADERS (the prefix), include full headers when forwarding."
+ (interactive "P")
+ (gnus-summary-mail-forward full-headers t))
+
+(defvar gnus-nastygram-message
+ "The following article was inappropriately posted to %s.\n\n"
+ "Format string to insert in nastygrams.
+The current group name will be inserted at \"%s\".")
+
+(defun gnus-summary-mail-nastygram (n)
+ "Send a nastygram to the author of the current article."
+ (interactive "P")
+ (when (or gnus-expert-user
+ (gnus-y-or-n-p
+ "Really send a nastygram to the author of the current article? "))
+ (let ((group gnus-newsgroup-name))
+ (gnus-summary-reply-with-original n)
+ (set-buffer gnus-message-buffer)
+ (message-goto-body)
+ (insert (format gnus-nastygram-message group))
+ (message-send-and-exit))))
+
+(defun gnus-summary-mail-crosspost-complaint (n)
+ "Send a complaint about crossposting to the current article(s)."
+ (interactive "P")
+ (let ((articles (gnus-summary-work-articles n))
+ article)
+ (while (setq article (pop articles))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-goto-subject article)
+ (let ((group (gnus-group-real-name gnus-newsgroup-name))
+ newsgroups followup-to)
+ (gnus-summary-select-article)
+ (set-buffer gnus-original-article-buffer)
+ (if (and (<= (length (message-tokenize-header
+ (setq newsgroups (mail-fetch-field "newsgroups"))
+ ", "))
+ 1)
+ (or (not (setq followup-to (mail-fetch-field "followup-to")))
+ (not (member group (message-tokenize-header
+ followup-to ", ")))))
+ (if followup-to
+ (gnus-message 1 "Followup-to restricted")
+ (gnus-message 1 "Not a crossposted article"))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-reply-with-original 1)
+ (set-buffer gnus-message-buffer)
+ (message-goto-body)
+ (insert (format gnus-crosspost-complaint newsgroups group))
+ (message-goto-subject)
+ (re-search-forward " *$")
+ (replace-match " (crosspost notification)" t t)
+ (gnus-deactivate-mark)
+ (when (gnus-y-or-n-p "Send this complaint? ")
+ (message-send-and-exit)))))))
+
+(defun gnus-summary-mail-other-window ()
+ "Compose mail in other window."
+ (interactive)
+ (gnus-setup-message 'message
+ (message-mail)))
+
+(defun gnus-mail-parse-comma-list ()
+ (let (accumulated
+ beg)
+ (skip-chars-forward " ")
+ (while (not (eobp))
+ (setq beg (point))
+ (skip-chars-forward "^,")
+ (while (zerop
+ (save-excursion
+ (save-restriction
+ (let ((i 0))
+ (narrow-to-region beg (point))
+ (goto-char beg)
+ (logand (progn
+ (while (search-forward "\"" nil t)
+ (incf i))
+ (if (zerop i) 2 i))
+ 2)))))
+ (skip-chars-forward ",")
+ (skip-chars-forward "^,"))
+ (skip-chars-backward " ")
+ (push (buffer-substring beg (point))
+ accumulated)
+ (skip-chars-forward "^,")
+ (skip-chars-forward ", "))
+ accumulated))
+
+(defun gnus-inews-add-to-address (group)
+ (let ((to-address (mail-fetch-field "to")))
+ (when (and to-address
+ (gnus-alive-p))
+ ;; This mail group doesn't have a `to-list', so we add one
+ ;; here. Magic!
+ (when (gnus-y-or-n-p
+ (format "Do you want to add this as `to-list': %s " to-address))
+ (gnus-group-add-parameter group (cons 'to-list to-address))))))
+
+(defun gnus-put-message ()
+ "Put the current message in some group and return to Gnus."
+ (interactive)
+ (let ((reply gnus-article-reply)
+ (winconf gnus-prev-winconf)
+ (group gnus-newsgroup-name))
+
+ (or (and group (not (gnus-group-read-only-p group)))
+ (setq group (read-string "Put in group: " nil
+ (gnus-writable-groups))))
+ (when (gnus-gethash group gnus-newsrc-hashtb)
+ (error "No such group: %s" group))
+
+ (save-excursion
+ (save-restriction
+ (widen)
+ (message-narrow-to-headers)
+ (let (gnus-deletable-headers)
+ (if (message-news-p)
+ (message-generate-headers message-required-news-headers)
+ (message-generate-headers message-required-mail-headers)))
+ (goto-char (point-max))
+ (insert "Gcc: " group "\n")
+ (widen)))
+
+ (gnus-inews-do-gcc)
+
+ (when (get-buffer gnus-group-buffer)
+ (when (gnus-buffer-exists-p (car-safe reply))
+ (set-buffer (car reply))
+ (and (cdr reply)
+ (gnus-summary-mark-article-as-replied
+ (cdr reply))))
+ (when winconf
+ (set-window-configuration winconf)))))
+
+(defun gnus-article-mail (yank)
+ "Send a reply to the address near point.
+If YANK is non-nil, include the original article."
+ (interactive "P")
+ (let ((address
+ (buffer-substring
+ (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
+ (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
+ (when address
+ (message-reply address)
+ (when yank
+ (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
+
+(defvar nntp-server-type)
+(defun gnus-bug ()
+ "Send a bug report to the Gnus maintainers."
+ (interactive)
+ (unless (gnus-alive-p)
+ (error "Gnus has been shut down"))
+ (gnus-setup-message 'bug
+ (delete-other-windows)
+ (switch-to-buffer (get-buffer-create "*Gnus Help Bug*"))
+ (erase-buffer)
+ (insert gnus-bug-message)
+ (goto-char (point-min))
+ (message-pop-to-buffer "*Gnus Bug*")
+ (message-setup `((To . ,gnus-maintainer) (Subject . "")))
+ (push `(gnus-bug-kill-buffer) message-send-actions)
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
+ (insert (gnus-version) "\n")
+ (insert (emacs-version) "\n")
+ (when (and (boundp 'nntp-server-type)
+ (stringp nntp-server-type))
+ (insert nntp-server-type))
+ (insert "\n\n\n\n\n")
+ (gnus-debug)
+ (goto-char (point-min))
+ (search-forward "Subject: " nil t)
+ (message "")))
+
+(defun gnus-bug-kill-buffer ()
+ (when (get-buffer "*Gnus Help Bug*")
+ (kill-buffer "*Gnus Help Bug*")))
+
+(defun gnus-debug ()
+ "Attempts to go through the Gnus source file and report what variables have been changed.
+The source file has to be in the Emacs load path."
+ (interactive)
+ (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el"
+ "gnus-art.el" "gnus-start.el" "gnus-async.el"
+ "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
+ "nnmail.el" "message.el"))
+ file expr olist sym)
+ (gnus-message 4 "Please wait while we snoop your variables...")
+ (sit-for 0)
+ ;; Go through all the files looking for non-default values for variables.
+ (save-excursion
+ (set-buffer (get-buffer-create " *gnus bug info*"))
+ (buffer-disable-undo (current-buffer))
+ (while files
+ (erase-buffer)
+ (when (and (setq file (locate-library (pop files)))
+ (file-exists-p file))
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (if (not (re-search-forward "^;;* *Internal variables" nil t))
+ (gnus-message 4 "Malformed sources in file %s" file)
+ (narrow-to-region (point-min) (point))
+ (goto-char (point-min))
+ (while (setq expr (ignore-errors (read (current-buffer))))
+ (ignore-errors
+ (and (or (eq (car expr) 'defvar)
+ (eq (car expr) 'defcustom))
+ (stringp (nth 3 expr))
+ (or (not (boundp (nth 1 expr)))
+ (not (equal (eval (nth 2 expr))
+ (symbol-value (nth 1 expr)))))
+ (push (nth 1 expr) olist)))))))
+ (kill-buffer (current-buffer)))
+ (when (setq olist (nreverse olist))
+ (insert "------------------ Environment follows ------------------\n\n"))
+ (while olist
+ (if (boundp (car olist))
+ (condition-case ()
+ (pp `(setq ,(car olist)
+ ,(if (or (consp (setq sym (symbol-value (car olist))))
+ (and (symbolp sym)
+ (not (or (eq sym nil)
+ (eq sym t)))))
+ (list 'quote (symbol-value (car olist)))
+ (symbol-value (car olist))))
+ (current-buffer))
+ (error
+ (format "(setq %s 'whatever)\n" (car olist))))
+ (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
+ (setq olist (cdr olist)))
+ (insert "\n\n")
+ ;; Remove any null chars - they seem to cause trouble for some
+ ;; mailers. (Byte-compiled output from the stuff above.)
+ (goto-char (point-min))
+ (while (re-search-forward "[\000\200]" nil t)
+ (replace-match "" t t))))
+
+;;; Treatment of rejected articles.
+;;; Bounced mail.
+
+(defun gnus-summary-resend-bounced-mail (&optional fetch)
+ "Re-mail the current message.
+This only makes sense if the current message is a bounce message than
+contains some mail you have written which has been bounced back to
+you.
+If FETCH, try to fetch the article that this is a reply to, if indeed
+this is a reply."
+ (interactive "P")
+ (gnus-summary-select-article t)
+ (set-buffer gnus-original-article-buffer)
+ (gnus-setup-message 'compose-bounce
+ (let* ((references (mail-fetch-field "references"))
+ (parent (and references (gnus-parent-id references))))
+ (message-bounce)
+ ;; If there are references, we fetch the article we answered to.
+ (and fetch parent
+ (gnus-summary-refer-article parent)
+ (gnus-summary-show-all-headers)))))
+
+;;; Gcc handling.
+
+;; Do Gcc handling, which copied the message over to some group.
+(defun gnus-inews-do-gcc (&optional gcc)
+ (interactive)
+ (when (gnus-alive-p)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
+ (cur (current-buffer))
+ groups group method)
+ (when gcc
+ (message-remove-header "gcc")
+ (widen)
+ (setq groups (message-tokenize-header gcc " ,"))
+ ;; Copy the article over to some group(s).
+ (while (setq group (pop groups))
+ (gnus-check-server
+ (setq method
+ (cond ((and (null (gnus-get-info group))
+ (eq (car gnus-message-archive-method)
+ (car
+ (gnus-server-to-method
+ (gnus-group-method group)))))
+ ;; If the group doesn't exist, we assume
+ ;; it's an archive group...
+ gnus-message-archive-method)
+ ;; Use the method.
+ ((gnus-info-method (gnus-get-info group))
+ (gnus-info-method (gnus-get-info group)))
+ ;; Find the method.
+ (t (gnus-group-method group)))))
+ (gnus-check-server method)
+ (unless (gnus-request-group group t method)
+ (gnus-request-create-group group method))
+ (save-excursion
+ (nnheader-set-temp-buffer " *acc*")
+ (insert-buffer-substring cur)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (replace-match "" t t ))
+ (unless (gnus-request-accept-article group method t)
+ (gnus-message 1 "Couldn't store article in group %s: %s"
+ group (gnus-status-message method))
+ (sit-for 2))
+ (kill-buffer (current-buffer))))))))))
+
+(defun gnus-inews-insert-gcc ()
+ "Insert Gcc headers based on `gnus-outgoing-message-group'."
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (let* ((group gnus-outgoing-message-group)
+ (gcc (cond
+ ((gnus-functionp group)
+ (funcall group))
+ ((or (stringp group) (list group))
+ group))))
+ (when gcc
+ (insert "Gcc: "
+ (if (stringp gcc) gcc
+ (mapconcat 'identity gcc " "))
+ "\n"))))))
+
+(defun gnus-inews-insert-archive-gcc (&optional group)
+ "Insert the Gcc to say where the article is to be archived."
+ (let* ((var gnus-message-archive-group)
+ (group (or group gnus-newsgroup-name ""))
+ result
+ gcc-self-val
+ (groups
+ (cond
+ ((null gnus-message-archive-method)
+ ;; Ignore.
+ nil)
+ ((stringp var)
+ ;; Just a single group.
+ (list var))
+ ((null var)
+ ;; We don't want this.
+ nil)
+ ((and (listp var) (stringp (car var)))
+ ;; A list of groups.
+ var)
+ ((gnus-functionp var)
+ ;; A function.
+ (funcall var group))
+ (t
+ ;; An alist of regexps/functions/forms.
+ (while (and var
+ (not
+ (setq result
+ (cond
+ ((stringp (caar var))
+ ;; Regexp.
+ (when (string-match (caar var) group)
+ (cdar var)))
+ ((gnus-functionp (car var))
+ ;; Function.
+ (funcall (car var) group))
+ (t
+ (eval (car var)))))))
+ (setq var (cdr var)))
+ result)))
+ name)
+ (when groups
+ (when (stringp groups)
+ (setq groups (list groups)))
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (goto-char (point-max))
+ (insert "Gcc: ")
+ (if (and gnus-newsgroup-name
+ (setq gcc-self-val
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'gcc-self)))
+ (progn
+ (insert
+ (if (stringp gcc-self-val)
+ gcc-self-val
+ group))
+ (if (not (eq gcc-self-val 'none))
+ (insert "\n")
+ (progn
+ (beginning-of-line)
+ (kill-line))))
+ (while (setq name (pop groups))
+ (insert (if (string-match ":" name)
+ name
+ (gnus-group-prefixed-name
+ name gnus-message-archive-method)))
+ (when groups
+ (insert " ")))
+ (insert "\n")))))))
+
+(gnus-add-shutdown 'gnus-inews-close 'gnus)
+
+(defun gnus-inews-close ()
+ (setq gnus-inews-sent-ids nil))
+
+;;; Allow redefinition of functions.
+
+(gnus-ems-redefine)
+
+(provide 'gnus-msg)
+
+;;; gnus-msg.el ends here
--- /dev/null
+;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'nnmail)
+(require 'gnus-art)
+(require 'gnus-sum)
+(require 'gnus-range)
+
+(defgroup gnus-nocem nil
+ "NoCeM pseudo-cancellation treatment"
+ :group 'gnus-score)
+
+(defcustom gnus-nocem-groups
+ '("news.lists.filters" "news.admin.net-abuse.bulletins"
+ "alt.nocem.misc" "news.admin.net-abuse.announce")
+ "List of groups that will be searched for NoCeM messages."
+ :group 'gnus-nocem
+ :type '(repeat (string :tag "Group")))
+
+(defcustom gnus-nocem-issuers
+ '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm]
+ "rbraver@ohww.norman.ok.us" ; Robert Braver
+ "clewis@ferret.ocunix.on.ca" ; Chris Lewis
+ "jem@xpat.com" ; Despammer from Korea
+ "snowhare@xmission.com" ; Benjamin "Snowhare" Franz
+ "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; ARMM! ARMM!
+ )
+ "List of NoCeM issuers to pay attention to.
+
+This can also be a list of `(ISSUER CONDITIONS)' elements."
+ :group 'gnus-nocem
+ :type '(repeat string))
+
+(defcustom gnus-nocem-directory
+ (nnheader-concat gnus-article-save-directory "NoCeM/")
+ "*Directory where NoCeM files will be stored."
+ :group 'gnus-nocem
+ :type 'directory)
+
+(defcustom gnus-nocem-expiry-wait 15
+ "*Number of days to keep NoCeM headers in the cache."
+ :group 'gnus-nocem
+ :type 'integer)
+
+(defcustom gnus-nocem-verifyer 'mc-verify
+ "*Function called to verify that the NoCeM message is valid.
+One likely value is `mc-verify'. If the function in this variable
+isn't bound, the message will be used unconditionally."
+ :group 'gnus-nocem
+ :type '(radio (function-item mc-verify)
+ (function :tag "other")))
+
+(defcustom gnus-nocem-liberal-fetch nil
+ "*If t try to fetch all messages which have @@NCM in the subject.
+Otherwise don't fetch messages which have references or whose message-id
+matches an previously scanned and verified nocem message."
+ :group 'gnus-nocem
+ :type 'boolean)
+
+;;; Internal variables
+
+(defvar gnus-nocem-active nil)
+(defvar gnus-nocem-alist nil)
+(defvar gnus-nocem-touched-alist nil)
+(defvar gnus-nocem-hashtb nil)
+(defvar gnus-nocem-seen-message-ids nil)
+
+;;; Functions
+
+(defun gnus-nocem-active-file ()
+ (concat (file-name-as-directory gnus-nocem-directory) "active"))
+
+(defun gnus-nocem-cache-file ()
+ (concat (file-name-as-directory gnus-nocem-directory) "cache"))
+
+;;
+;; faster lookups for group names:
+;;
+
+(defvar gnus-nocem-real-group-hashtb nil
+ "Real-name mappings of subscribed groups.")
+
+(defun gnus-fill-real-hashtb ()
+ "Fill up a hash table with the real-name mappings from the user's
+active file."
+ (setq gnus-nocem-real-group-hashtb (gnus-make-hashtable
+ (length gnus-newsrc-alist)))
+ (mapcar (lambda (group)
+ (setq group (gnus-group-real-name (car group)))
+ (gnus-sethash group t gnus-nocem-real-group-hashtb))
+ gnus-newsrc-alist))
+
+(defun gnus-nocem-scan-groups ()
+ "Scan all NoCeM groups for new NoCeM messages."
+ (interactive)
+ (let ((groups gnus-nocem-groups)
+ (gnus-inhibit-demon t)
+ group active gactive articles)
+ (gnus-make-directory gnus-nocem-directory)
+ ;; Load any previous NoCeM headers.
+ (gnus-nocem-load-cache)
+ ;; Get the group name mappings:
+ (gnus-fill-real-hashtb)
+ ;; Read the active file if it hasn't been read yet.
+ (and (file-exists-p (gnus-nocem-active-file))
+ (not gnus-nocem-active)
+ (ignore-errors
+ (load (gnus-nocem-active-file) t t t)))
+ ;; Go through all groups and see whether new articles have
+ ;; arrived.
+ (while (setq group (pop groups))
+ (if (not (setq gactive (gnus-activate-group group)))
+ () ; This group doesn't exist.
+ (setq active (nth 1 (assoc group gnus-nocem-active)))
+ (when (and (not (< (cdr gactive) (car gactive))) ; Empty group.
+ (or (not active)
+ (< (cdr active) (cdr gactive))))
+ ;; Ok, there are new articles in this group, se we fetch the
+ ;; headers.
+ (save-excursion
+ (let ((dependencies (make-vector 10 nil))
+ headers header)
+ (nnheader-temp-write nil
+ (setq headers
+ (if (eq 'nov
+ (gnus-retrieve-headers
+ (setq articles
+ (gnus-uncompress-range
+ (cons
+ (if active (1+ (cdr active))
+ (car gactive))
+ (cdr gactive))))
+ group))
+ (gnus-get-newsgroup-headers-xover
+ articles nil dependencies)
+ (gnus-get-newsgroup-headers dependencies)))
+ (while (setq header (pop headers))
+ ;; We take a closer look on all articles that have
+ ;; "@@NCM" in the subject. Unless we already read
+ ;; this cross posted message. Nocem messages
+ ;; are not allowed to have references, so we can
+ ;; ignore scanning followups.
+ (and (string-match "@@NCM" (mail-header-subject header))
+ (or gnus-nocem-liberal-fetch
+ (and (or (string= "" (mail-header-references
+ header))
+ (null (mail-header-references header)))
+ (not (member (mail-header-message-id header)
+ gnus-nocem-seen-message-ids))))
+ (gnus-nocem-check-article group header)))))))
+ (setq gnus-nocem-active
+ (cons (list group gactive)
+ (delq (assoc group gnus-nocem-active)
+ gnus-nocem-active)))))
+ ;; Save the results, if any.
+ (gnus-nocem-save-cache)
+ (gnus-nocem-save-active)))
+
+(defun gnus-nocem-check-article (group header)
+ "Check whether the current article is an NCM article and that we want it."
+ ;; Get the article.
+ (gnus-message 7 "Checking article %d in %s for NoCeM..."
+ (mail-header-number header) group)
+ (let ((date (mail-header-date header))
+ issuer b e type)
+ (when (or (not date)
+ (nnmail-time-less
+ (nnmail-time-since (nnmail-date-to-time date))
+ (nnmail-days-to-time gnus-nocem-expiry-wait)))
+ (gnus-request-article-this-buffer (mail-header-number header) group)
+ (goto-char (point-min))
+ (when (re-search-forward "-----BEGIN PGP MESSAGE-----" nil t)
+ (delete-region (point-min) (match-beginning 0)))
+ (when (re-search-forward "-----END PGP MESSAGE-----\n?" nil t)
+ (delete-region (match-end 0) (point-max)))
+ (goto-char (point-min))
+ ;; The article has to have proper NoCeM headers.
+ (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t))
+ (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t)))
+ ;; We get the name of the issuer.
+ (narrow-to-region b e)
+ (setq issuer (mail-fetch-field "issuer")
+ type (mail-fetch-field "issuer"))
+ (widen)
+ (if (not (gnus-nocem-message-wanted-p issuer type))
+ (message "invalid NoCeM issuer: %s" issuer)
+ (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is.
+ (gnus-nocem-enter-article) ; We gobble the message.
+ (push (mail-header-message-id header) ; But don't come back for
+ gnus-nocem-seen-message-ids))))))) ; second helpings.
+
+(defun gnus-nocem-message-wanted-p (issuer type)
+ (let ((issuers gnus-nocem-issuers)
+ wanted conditions condition)
+ (cond
+ ;; Do the quick check first.
+ ((member issuer issuers)
+ t)
+ ((setq conditions (cdr (assoc issuer issuers)))
+ ;; Check whether we want this type.
+ (while (setq condition (pop conditions))
+ (cond
+ ((stringp condition)
+ (setq wanted (string-match condition) type))
+ ((and (consp condition)
+ (eq (car condition) 'not)
+ (stringp (cadr condition)))
+ (setq wanted (not (string-match (cadr condition) type))))
+ (t
+ (error "Invalid NoCeM condition: %S" condition))))
+ wanted))))
+
+(defun gnus-nocem-verify-issuer (person)
+ "Verify using PGP that the canceler is who she says she is."
+ (if (fboundp gnus-nocem-verifyer)
+ (ignore-errors
+ (funcall gnus-nocem-verifyer))
+ ;; If we don't have Mailcrypt, then we use the message anyway.
+ t))
+
+(defun gnus-nocem-enter-article ()
+ "Enter the current article into the NoCeM cache."
+ (goto-char (point-min))
+ (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t))
+ (e (search-forward "\n@@END NCM BODY\n" nil t))
+ (buf (current-buffer))
+ ncm id group)
+ (when (and b e)
+ (narrow-to-region b (1+ (match-beginning 0)))
+ (goto-char (point-min))
+ (while (search-forward "\t" nil t)
+ (cond
+ ((not (ignore-errors
+ (setq group (let ((obarray gnus-active-hashtb)) (read buf)))))
+ ;; An error.
+ )
+ ((not (symbolp group))
+ ;; Ignore invalid entries.
+ )
+ ((not (boundp group))
+ ;; Make sure all entries in the hashtb are bound.
+ (set group nil))
+ (t
+ (when (gnus-gethash (gnus-group-real-name (symbol-name group))
+ gnus-nocem-real-group-hashtb)
+ ;; Valid group.
+ (beginning-of-line)
+ (while (= (following-char) ?\t)
+ (forward-line -1))
+ (setq id (buffer-substring (point) (1- (search-forward "\t"))))
+ (unless (gnus-gethash id gnus-nocem-hashtb)
+ ;; only store if not already present
+ (gnus-sethash id t gnus-nocem-hashtb)
+ (push id ncm))
+ (forward-line 1)
+ (while (= (following-char) ?\t)
+ (forward-line 1))))))
+ (when ncm
+ (setq gnus-nocem-touched-alist t)
+ (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time)
+ ncm)
+ gnus-nocem-alist))
+ t)))
+
+(defun gnus-nocem-load-cache ()
+ "Load the NoCeM cache."
+ (interactive)
+ (unless gnus-nocem-alist
+ ;; The buffer doesn't exist, so we create it and load the NoCeM
+ ;; cache.
+ (when (file-exists-p (gnus-nocem-cache-file))
+ (load (gnus-nocem-cache-file) t t t)
+ (gnus-nocem-alist-to-hashtb))))
+
+(defun gnus-nocem-save-cache ()
+ "Save the NoCeM cache."
+ (when (and gnus-nocem-alist
+ gnus-nocem-touched-alist)
+ (nnheader-temp-write (gnus-nocem-cache-file)
+ (gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist)))
+ (setq gnus-nocem-touched-alist nil)))
+
+(defun gnus-nocem-save-active ()
+ "Save the NoCeM active file."
+ (nnheader-temp-write (gnus-nocem-active-file)
+ (gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active))))
+
+(defun gnus-nocem-alist-to-hashtb ()
+ "Create a hashtable from the Message-IDs we have."
+ (let* ((alist gnus-nocem-alist)
+ (pprev (cons nil alist))
+ (prev pprev)
+ (expiry (nnmail-days-to-time gnus-nocem-expiry-wait))
+ entry)
+ (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51)))
+ (while (setq entry (car alist))
+ (if (not (nnmail-time-less (nnmail-time-since (car entry)) expiry))
+ ;; This entry has expired, so we remove it.
+ (setcdr prev (cdr alist))
+ (setq prev alist)
+ ;; This is ok, so we enter it into the hashtable.
+ (setq entry (cdr entry))
+ (while entry
+ (gnus-sethash (car entry) t gnus-nocem-hashtb)
+ (setq entry (cdr entry))))
+ (setq alist (cdr alist)))))
+
+(gnus-add-shutdown 'gnus-nocem-close 'gnus)
+
+(defun gnus-nocem-close ()
+ "Clear internal NoCeM variables."
+ (setq gnus-nocem-alist nil
+ gnus-nocem-hashtb nil
+ gnus-nocem-active nil
+ gnus-nocem-touched-alist nil
+ gnus-nocem-seen-message-ids nil
+ gnus-nocem-real-group-hashtb nil))
+
+(defun gnus-nocem-unwanted-article-p (id)
+ "Say whether article ID in the current group is wanted."
+ (gnus-gethash id gnus-nocem-hashtb))
+
+(provide 'gnus-nocem)
+
+;;; gnus-nocem.el ends here
--- /dev/null
+;;; gnus-picon.el --- displaying pretty icons in Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu>
+;; Keywords: news xpm annotation glyph faces
+
+;; 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(require 'xpm)
+(require 'annotations)
+(require 'custom)
+(require 'gnus-art)
+(require 'gnus-win)
+
+;;; User variables:
+
+(defgroup picons nil
+ "Show pictures of people, domains, and newsgroups (XEmacs).
+For this to work, you must add gnus-group-display-picons to the
+gnus-summary-display-hook or to the gnus-article-display-hook
+depending on what gnus-picons-display-where is set to. You must
+also add gnus-article-display-picons to gnus-article-display-hook."
+ :group 'gnus-visual)
+
+(defcustom gnus-picons-display-where 'picons
+ "Where to display the group and article icons.
+Legal values are `article' and `picons'."
+ :type '(choice symbol string)
+ :group 'picons)
+
+(defcustom gnus-picons-has-modeline-p t
+ "Wether the picons window should have a modeline.
+This is only useful if `gnus-picons-display-where' is `picons'."
+ :type 'boolean
+ :group 'picons)
+
+(defcustom gnus-picons-database "/usr/local/faces"
+ "Defines the location of the faces database.
+For information on obtaining this database of pretty pictures, please
+see http://www.cs.indiana.edu/picons/ftp/index.html"
+ :type 'directory
+ :group 'picons)
+
+(defcustom gnus-picons-news-directories '("news")
+ "Sub-directory of the faces database containing the icons for newsgroups."
+ :type '(repeat string)
+ :group 'picons)
+(define-obsolete-variable-alias 'gnus-picons-news-directory
+ 'gnus-picons-news-directories)
+
+(defcustom gnus-picons-user-directories '("local" "users" "usenix" "misc")
+ "List of directories to search for user faces."
+ :type '(repeat string)
+ :group 'picons)
+
+(defcustom gnus-picons-domain-directories '("domains")
+ "List of directories to search for domain faces.
+Some people may want to add \"unknown\" to this list."
+ :type '(repeat string)
+ :group 'picons)
+
+(defcustom gnus-picons-refresh-before-display nil
+ "If non-nil, display the article buffer before computing the picons."
+ :type 'boolean
+ :group 'picons)
+
+(defcustom gnus-picons-x-face-file-name
+ (format "/tmp/picon-xface.%s.xbm" (user-login-name))
+ "The name of the file in which to store the converted X-face header."
+ :type 'string
+ :group 'picons)
+
+(defcustom gnus-picons-convert-x-face (format "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | pbmtoxbm > %s" gnus-picons-x-face-file-name)
+ "Command to convert the x-face header into a xbm file."
+ :type 'string
+ :group 'picons)
+
+(defcustom gnus-picons-display-as-address t
+ "*If t display textual email addresses along with pictures."
+ :type 'boolean
+ :group 'picons)
+
+(defcustom gnus-picons-file-suffixes
+ (when (featurep 'x)
+ (let ((types (list "xbm")))
+ (when (featurep 'gif)
+ (push "gif" types))
+ (when (featurep 'xpm)
+ (push "xpm" types))
+ types))
+ "List of suffixes on picon file names to try."
+ :type '(repeat string)
+ :group 'picons)
+
+(defcustom gnus-picons-display-article-move-p t
+ "*Whether to move point to first empty line when displaying picons.
+This has only an effect if `gnus-picons-display-where' has value `article'."
+ :type 'boolean
+ :group 'picons)
+
+(defcustom gnus-picons-clear-cache-on-shutdown t
+ "*Whether to clear the picons cache when exiting gnus.
+Gnus caches every picons it finds while it is running. This saves
+some time in the search process but eats some memory. If this
+variable is set to nil, Gnus will never clear the cache itself; you
+will have to manually call `gnus-picons-clear-cache' to clear it.
+Otherwise the cache will be cleared every time you exit Gnus."
+ :type 'boolean
+ :group 'picons)
+
+(defcustom gnus-picons-piconsearch-url nil
+ "*The url to query for picons. Setting this to nil will disable it.
+The only publicly available address currently known is
+http://www.cs.indiana.edu:800/piconsearch. If you know of any other,
+please tell me so that we can list it."
+ :type '(choice (const :tag "Disable" :value nil)
+ (const :tag "www.cs.indiana.edu"
+ :value "http://www.cs.indiana.edu:800/piconsearch")
+ (string))
+ :group 'picons)
+
+;;; Internal variables:
+
+(defvar gnus-picons-processes-alist nil
+ "Picons processes currently running and their environment.")
+(defvar gnus-picons-glyph-alist nil
+ "Picons glyphs cache.
+List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.")
+(defvar gnus-picons-url-alist nil
+ "Picons file names cache.
+List of pairs (KEY . NAME) where KEY is (USER HOST DBS) and NAME is an URL.")
+
+(defvar gnus-group-annotations nil
+ "List of annotations added/removed when selecting/exiting a group")
+(defvar gnus-article-annotations nil
+ "List of annotations added/removed when selecting an article")
+(defvar gnus-x-face-annotations nil
+ "List of annotations added/removed when selecting an article with an
+X-Face.")
+
+(defvar gnus-picons-jobs-alist nil
+ "List of jobs that still need be done.
+This is a list of (SYM-ANN TAG ARGS...) where SYM-ANN three annotations list,
+TAG is one of `picon' or `search' indicating that the job should query a
+picon or do a search for picons file names, and ARGS is some additionnal
+arguments necessary for the job.")
+
+(defvar gnus-picons-job-already-running nil
+ "Lock to ensure only one stream of http requests is running.")
+
+;;; Functions:
+
+(defun gnus-picons-remove (symbol)
+ "Remove all annotations in variable named SYMBOL.
+This function is careful to set it to nil before removing anything so that
+asynchronous process don't get crazy."
+ (setq gnus-picons-jobs-alist (remassq symbol gnus-picons-jobs-alist))
+ ;; notify running job that it may have been preempted
+ (if (eq (car gnus-picons-job-already-running) symbol)
+ (setq gnus-picons-job-already-running t))
+ ;; clear all annotations
+ (mapc (function (lambda (item)
+ (if (annotationp item)
+ (delete-annotation item))))
+ (prog1 (symbol-value symbol)
+ (set symbol nil))))
+
+(defun gnus-picons-remove-all ()
+ "Removes all picons from the Gnus display(s)."
+ (interactive)
+ (gnus-picons-remove 'gnus-article-annotations)
+ (gnus-picons-remove 'gnus-group-annotations)
+ (gnus-picons-remove 'gnus-x-face-annotations))
+
+(defun gnus-get-buffer-name (variable)
+ "Returns the buffer name associated with the contents of a variable."
+ (cond ((symbolp variable) (let ((newvar (cdr (assq variable
+ gnus-window-to-buffer))))
+ (cond ((symbolp newvar)
+ (symbol-value newvar))
+ ((stringp newvar) newvar))))
+ ((stringp variable) variable)))
+
+(defun gnus-picons-set-buffer ()
+ (set-buffer
+ (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where)))
+ (gnus-add-current-to-buffer-list)
+ (goto-char (point-min))
+ (if (and (eq gnus-picons-display-where 'article)
+ gnus-picons-display-article-move-p)
+ (if (search-forward "\n\n" nil t)
+ (forward-line -1)
+ (goto-char (point-max)))
+ (setq buffer-read-only t)
+ (unless gnus-picons-has-modeline-p
+ (set-specifier has-modeline-p
+ (list (list (current-buffer)
+ (cons nil gnus-picons-has-modeline-p)))))))
+
+(defun gnus-picons-prepare-for-annotations (annotations)
+ "Prepare picons buffer for puting annotations memorized in ANNOTATIONS.
+ANNOTATIONS should be a symbol naming a variable wich contains a list of
+annotations. Sets buffer to `gnus-picons-display-where'."
+ ;; let drawing catch up
+ (when gnus-picons-refresh-before-display
+ (sit-for 0))
+ (gnus-picons-set-buffer)
+ (gnus-picons-remove annotations))
+
+(defsubst gnus-picons-make-annotation (&rest args)
+ (let ((annot (apply 'make-annotation args)))
+ (set-extent-property annot 'duplicable nil)
+ annot))
+
+(defun gnus-picons-article-display-x-face ()
+ "Display the x-face header bitmap in the 'gnus-picons-display-where buffer."
+ ;; delete any old ones.
+ ;; This is needed here because gnus-picons-display-x-face will not
+ ;; be called if there is no X-Face header
+ (gnus-picons-remove 'gnus-x-face-annotations)
+ ;; display the new one.
+ (let ((gnus-article-x-face-command 'gnus-picons-display-x-face))
+ (gnus-article-display-x-face)))
+
+(defun gnus-picons-x-face-sentinel (process event)
+ (let* ((env (assq process gnus-picons-processes-alist))
+ (annot (cdr env)))
+ (setq gnus-picons-processes-alist (remassq process
+ gnus-picons-processes-alist))
+ (when annot
+ (set-annotation-glyph annot
+ (make-glyph gnus-picons-x-face-file-name))
+ (if (memq annot gnus-x-face-annotations)
+ (delete-file gnus-picons-x-face-file-name)))))
+
+(defun gnus-picons-display-x-face (beg end)
+ "Function to display the x-face header in the picons window.
+To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
+ (interactive)
+ (if (featurep 'xface)
+ ;; Use builtin support
+ (let ((buf (current-buffer)))
+ (save-excursion
+ (gnus-picons-prepare-for-annotations 'gnus-x-face-annotations)
+ (setq gnus-x-face-annotations
+ (cons (gnus-picons-make-annotation
+ (vector 'xface
+ :data (concat "X-Face: "
+ (buffer-substring beg end buf)))
+ nil 'text)
+ gnus-x-face-annotations))))
+ ;; convert the x-face header to a .xbm file
+ (let* ((process-connection-type nil)
+ (annot (save-excursion
+ (gnus-picons-prepare-for-annotations
+ 'gnus-x-face-annotations)
+ (gnus-picons-make-annotation nil nil 'text)))
+ (process (start-process-shell-command "gnus-x-face" nil
+ gnus-picons-convert-x-face)))
+ (push annot gnus-x-face-annotations)
+ (push (cons process annot) gnus-picons-processes-alist)
+ (process-kill-without-query process)
+ (set-process-sentinel process 'gnus-picons-x-face-sentinel)
+ (process-send-region process beg end)
+ (process-send-eof process))))
+
+(defun gnus-article-display-picons ()
+ "Display faces for an author and his/her domain in gnus-picons-display-where."
+ (interactive)
+ (let (from at-idx)
+ (when (and (featurep 'xpm)
+ (or (not (fboundp 'device-type)) (equal (device-type) 'x))
+ (setq from (mail-fetch-field "from"))
+ (setq from (downcase (or (cadr (mail-extract-address-components
+ from))
+ "")))
+ (or (setq at-idx (string-match "@" from))
+ (setq at-idx (length from))))
+ (save-excursion
+ (let ((username (downcase (substring from 0 at-idx)))
+ (addrs (if (eq at-idx (length from))
+ (if gnus-local-domain
+ (message-tokenize-header gnus-local-domain "."))
+ (message-tokenize-header (substring from (1+ at-idx))
+ "."))))
+ (gnus-picons-prepare-for-annotations 'gnus-article-annotations)
+ ;; if display in article buffer, the group annotations
+ ;; wrongly placed. Move them here
+ (if (eq gnus-picons-display-where 'article)
+ (dolist (ext gnus-group-annotations)
+ (set-extent-endpoints ext (point) (point))))
+ (if (null gnus-picons-piconsearch-url)
+ (setq gnus-article-annotations
+ (nconc gnus-article-annotations
+ (gnus-picons-display-pairs
+ (gnus-picons-lookup-pairs
+ addrs gnus-picons-domain-directories)
+ gnus-picons-display-as-address
+ "." t)
+ (if (and gnus-picons-display-as-address addrs)
+ (list (gnus-picons-make-annotation
+ [string :data "@"] nil
+ 'text nil nil nil t)))
+ (gnus-picons-display-picon-or-name
+ (gnus-picons-lookup-user username addrs)
+ username t)))
+ (push (list 'gnus-article-annotations 'search username addrs
+ gnus-picons-domain-directories t)
+ gnus-picons-jobs-alist)
+ (gnus-picons-next-job))
+
+ (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))))
+
+(defun gnus-group-display-picons ()
+ "Display icons for the group in the gnus-picons-display-where buffer."
+ (interactive)
+ (when (and (featurep 'xpm)
+ (or (not (fboundp 'device-type)) (equal (device-type) 'x)))
+ (save-excursion
+ (gnus-picons-prepare-for-annotations 'gnus-group-annotations)
+ (if (null gnus-picons-piconsearch-url)
+ (setq gnus-group-annotations
+ (gnus-picons-display-pairs
+ (gnus-picons-lookup-pairs (reverse (message-tokenize-header
+ (gnus-group-real-name gnus-newsgroup-name)
+ "."))
+ gnus-picons-news-directories)
+ t "."))
+ (push (list 'gnus-group-annotations 'search nil
+ (message-tokenize-header
+ (gnus-group-real-name gnus-newsgroup-name) ".")
+ (if (listp gnus-picons-news-directories)
+ gnus-picons-news-directories
+ (list gnus-picons-news-directories))
+ nil)
+ gnus-picons-jobs-alist)
+ (gnus-picons-next-job))
+
+ (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))
+
+(defsubst gnus-picons-lookup-internal (addrs dir)
+ (setq dir (expand-file-name dir gnus-picons-database))
+ (gnus-picons-try-face (dolist (part (reverse addrs) dir)
+ (setq dir (expand-file-name part dir)))))
+
+(defun gnus-picons-lookup (addrs dirs)
+ "Lookup the picon for ADDRS in databases DIRS.
+Returns the picon filename or NIL if none found."
+ (let (result)
+ (while (and dirs (null result))
+ (setq result (gnus-picons-lookup-internal addrs (pop dirs))))
+ result))
+
+(defun gnus-picons-lookup-user-internal (user domains)
+ (let ((dirs gnus-picons-user-directories)
+ domains-tmp dir picon)
+ (while (and dirs (null picon))
+ (setq domains-tmp domains
+ dir (pop dirs))
+ (while (and domains-tmp
+ (null (setq picon (gnus-picons-lookup-internal
+ (cons user domains-tmp) dir))))
+ (pop domains-tmp))
+ ;; Also make a try in MISC subdir
+ (unless picon
+ (setq picon (gnus-picons-lookup-internal (list user "MISC") dir))))
+ picon))
+
+(defun gnus-picons-lookup-user (user domains)
+ "Lookup the picon for USER at DOMAINS.
+USER is a string containing a name.
+DOMAINS is a list of strings from the fully qualified domain name."
+ (or (gnus-picons-lookup-user-internal user domains)
+ (gnus-picons-lookup-user-internal "unknown" domains)))
+
+(defun gnus-picons-lookup-pairs (domains directories)
+ "Lookup picons for DOMAINS and all its parents in DIRECTORIES.
+Returns a list of PAIRS whose CAR is the picon filename or NIL if
+none, and whose CDR is the corresponding element of DOMAINS."
+ (let (picons)
+ (setq directories (if (listp directories)
+ directories
+ (list directories)))
+ (while domains
+ (push (list (gnus-picons-lookup (cons "unknown" domains) directories)
+ (pop domains))
+ picons))
+ picons))
+
+(defun gnus-picons-display-picon-or-name (picon name &optional right-p)
+ (cond (picon (gnus-picons-display-glyph picon name right-p))
+ (gnus-picons-display-as-address (list (gnus-picons-make-annotation
+ (vector 'string :data name)
+ nil 'text
+ nil nil nil right-p)))))
+
+(defun gnus-picons-display-pairs (pairs &optional bar-p dot-p right-p)
+ "Display picons in list PAIRS."
+ (let ((domain-p (and gnus-picons-display-as-address dot-p))
+ pair picons)
+ (if (and bar-p domain-p right-p)
+ (setq picons (gnus-picons-display-glyph
+ (gnus-picons-try-face gnus-xmas-glyph-directory
+ "bar.")
+ nil right-p)))
+ (while pairs
+ (setq pair (pop pairs)
+ picons (nconc picons
+ (gnus-picons-display-picon-or-name (car pair)
+ (cadr pair)
+ right-p)
+ (if (and domain-p pairs)
+ (list (gnus-picons-make-annotation
+ (vector 'string :data dot-p)
+ nil 'text nil nil nil right-p))))))
+ (if (and bar-p domain-p (not right-p))
+ (setq picons (nconc picons
+ (gnus-picons-display-glyph
+ (gnus-picons-try-face gnus-xmas-glyph-directory
+ "bar.")
+ nil right-p))))
+ picons))
+
+(defun gnus-picons-try-face (dir &optional filebase)
+ (let* ((dir (file-name-as-directory dir))
+ (filebase (or filebase "face."))
+ (key (concat dir filebase))
+ (glyph (cdr (assoc key gnus-picons-glyph-alist)))
+ (suffixes gnus-picons-file-suffixes)
+ f)
+ (while (and suffixes (null glyph))
+ (when (file-exists-p (setq f (expand-file-name (concat filebase
+ (pop suffixes))
+ dir)))
+ (setq glyph (make-glyph f))
+ (push (cons key glyph) gnus-picons-glyph-alist)))
+ glyph))
+
+(defun gnus-picons-display-glyph (glyph &optional part rightp)
+ (let ((new (gnus-picons-make-annotation glyph (point)
+ 'text nil nil nil rightp)))
+ (when (and part gnus-picons-display-as-address)
+ (set-annotation-data new (cons new
+ (make-glyph (vector 'string :data part))))
+ (set-annotation-action new 'gnus-picons-action-toggle))
+ (nconc
+ (list new)
+ (if (and (eq major-mode 'gnus-article-mode)
+ (not gnus-picons-display-as-address)
+ (not part))
+ (list (gnus-picons-make-annotation [string :data " "] (point)
+ 'text nil nil nil rightp))))))
+
+(defun gnus-picons-action-toggle (data)
+ "Toggle annotation"
+ (interactive "e")
+ (let* ((annot (car data))
+ (glyph (annotation-glyph annot)))
+ (set-annotation-glyph annot (cdr data))
+ (set-annotation-data annot (cons annot glyph))))
+
+(defun gnus-picons-clear-cache ()
+ "Clear the picons cache"
+ (interactive)
+ (setq gnus-picons-glyph-alist nil
+ gnus-picons-url-alist nil))
+
+(gnus-add-shutdown 'gnus-picons-close 'gnus)
+
+(defun gnus-picons-close ()
+ "Shut down the picons."
+ (if gnus-picons-clear-cache-on-shutdown
+ (gnus-picons-clear-cache)))
+
+;;; Query a remote DB. This requires some stuff from w3 !
+
+(require 'url)
+(require 'w3-forms)
+
+(defun gnus-picons-url-retrieve (url fn arg)
+ (let ((old-asynch (default-value 'url-be-asynchronous))
+ (url-working-buffer (generate-new-buffer " *picons*"))
+ (url-package-name "Gnus")
+ (url-package-version gnus-version-number)
+ url-request-method)
+ (setq-default url-be-asynchronous t)
+ (save-excursion
+ (set-buffer url-working-buffer)
+ (setq url-be-asynchronous t
+ url-current-callback-data arg
+ url-current-callback-func fn)
+ (url-retrieve url t))
+ (setq-default url-be-asynchronous old-asynch)))
+
+(defun gnus-picons-make-glyph (type)
+ "Make a TYPE glyph using current buffer as data. Handles xbm nicely."
+ (cond ((null type) nil)
+ ((eq type 'xbm) (let ((fname (make-temp-name "/tmp/picon")))
+ (write-region (point-min) (point-max) fname
+ nil 'quiet)
+ (prog1 (make-glyph (vector 'xbm :file fname))
+ (delete-file fname))))
+ (t (make-glyph (vector type :data (buffer-string))))))
+
+;;; Parsing of piconsearch result page.
+
+;; Assumes:
+;; 1 - each value field has the form: "<strong>key</strong> = <kbd>value</kbd>"
+;; 2 - a "<p>" separates the keywords from the results
+;; 3 - every results begins by the path within the database at the beginning
+;; of the line in raw text.
+;; 3b - and the href following it is the preferred image type.
+
+;; if 1 or 2 is not met, it will probably cause an error. The other
+;; will go undetected
+
+(defun gnus-picons-parse-value (name)
+ (goto-char (point-min))
+ (re-search-forward (concat "<strong>"
+ (regexp-quote name)
+ "</strong> *= *<kbd> *\\([^ <][^<]*\\) *</kbd>"))
+ (buffer-substring (match-beginning 1) (match-end 1)))
+
+(defun gnus-picons-parse-filenames ()
+ ;; returns an alist of ((USER ADDRS DB) . URL)
+ (let* ((case-fold-search t)
+ (user (gnus-picons-parse-value "user"))
+ (host (gnus-picons-parse-value "host"))
+ (dbs (message-tokenize-header (gnus-picons-parse-value "db") " "))
+ (start-re
+ (concat
+ ;; dbs
+ "^\\(" (mapconcat 'identity dbs "\\|") "\\)/"
+ ;; host
+ "\\(\\(" (replace-in-string host "\\." "/\\|" t) "/\\|MISC/\\)*\\)"
+ ;; user
+ "\\(" (regexp-quote user) "\\|unknown\\)/"
+ "face\\."))
+ cur-db cur-host cur-user types res)
+ ;; now point will be somewhere in the header. Find beginning of
+ ;; entries
+ (re-search-forward "<p>[ \t\n]*")
+ (while (re-search-forward start-re nil t)
+ (setq cur-db (buffer-substring (match-beginning 1) (match-end 1))
+ cur-host (buffer-substring (match-beginning 2) (match-end 2))
+ cur-user (buffer-substring (match-beginning 4) (match-end 4))
+ cur-host (nreverse (message-tokenize-header cur-host "/")))
+ ;; XXX - KLUDGE: there is a blank picon in news/MISC/unknown
+ (unless (and (string-equal cur-db "news")
+ (string-equal cur-user "unknown")
+ (equal cur-host '("MISC")))
+ ;; ok now we have found an entry (USER HOST DB), find the
+ ;; corresponding picon URL
+ (save-restriction
+ ;; restrict region to this entry
+ (narrow-to-region (point) (search-forward "<br>"))
+ (goto-char (point-min))
+ (setq types gnus-picons-file-suffixes)
+ (while (and types
+ (not (re-search-forward
+ (concat "<a[ \t\n]+href=\"\\([^\"]*\\."
+ (regexp-quote (car types)) "\\)\"")
+ nil t)))
+ (pop types))
+ (push (cons (list cur-user cur-host cur-db)
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ res))))
+ (nreverse res)))
+
+;;; picon network display functions :
+
+(defun gnus-picons-network-display-internal (sym-ann glyph part right-p)
+ (gnus-picons-set-buffer)
+ (set sym-ann (nconc (symbol-value sym-ann)
+ (gnus-picons-display-picon-or-name glyph part right-p)))
+ (gnus-picons-next-job-internal))
+
+(defun gnus-picons-network-display-callback (url part sym-ann right-p)
+ (let ((glyph (gnus-picons-make-glyph (cdr (assoc url-current-mime-type
+ w3-image-mappings)))))
+ (kill-buffer (current-buffer))
+ (push (cons url glyph) gnus-picons-glyph-alist)
+ ;; only do the job if it has not been preempted.
+ (if (equal gnus-picons-job-already-running
+ (list sym-ann 'picon url part right-p))
+ (gnus-picons-network-display-internal sym-ann glyph part right-p)
+ (gnus-picons-next-job-internal))))
+
+(defun gnus-picons-network-display (url part sym-ann right-p)
+ (let ((cache (assoc url gnus-picons-glyph-alist)))
+ (if (or cache (null url))
+ (gnus-picons-network-display-internal sym-ann (cdr cache) part right-p)
+ (gnus-picons-url-retrieve url 'gnus-picons-network-display-callback
+ (list url part sym-ann right-p)))))
+
+;;; search job functions
+
+(defun gnus-picons-network-search-internal (user addrs dbs sym-ann right-p
+ &optional fnames)
+ (let (curkey dom pfx url dbs-tmp cache new-jobs)
+ ;; First do the domain search
+ (dolist (part (if right-p
+ (reverse addrs)
+ addrs))
+ (setq pfx (nconc (list part) pfx)
+ dom (cond ((and dom right-p) (concat part "." dom))
+ (dom (concat dom "." part))
+ (t part))
+ curkey (list "unknown" dom dbs))
+ (when (null (setq cache (assoc curkey gnus-picons-url-alist)))
+ ;; This one is not yet in the cache, create a new entry
+ ;; Search for an entry
+ (setq dbs-tmp dbs
+ url nil)
+ (while (and dbs-tmp (null url))
+ (setq url (or (cdr (assoc (list "unknown" pfx (car dbs-tmp)) fnames))
+ (and (eq dom part)
+ ;; This is the first component. Try the
+ ;; catch-all MISC component
+ (cdr (assoc (list "unknown"
+ '("MISC")
+ (car dbs-tmp))
+ fnames)))))
+ (pop dbs-tmp))
+ (push (setq cache (cons curkey url)) gnus-picons-url-alist))
+ ;; Put this glyph in the job list
+ (if (and (not (eq dom part)) gnus-picons-display-as-address)
+ (push (list sym-ann "." right-p) new-jobs))
+ (push (list sym-ann 'picon (cdr cache) part right-p) new-jobs))
+ ;; next, the user search
+ (when user
+ (setq curkey (list user dom gnus-picons-user-directories))
+ (if (null (setq cache (assoc curkey gnus-picons-url-alist)))
+ (let ((users (list user "unknown"))
+ dirs usr domains-tmp dir picon)
+ (while (and users (null picon))
+ (setq dirs gnus-picons-user-directories
+ usr (pop users))
+ (while (and dirs (null picon))
+ (setq domains-tmp addrs
+ dir (pop dirs))
+ (while (and domains-tmp
+ (null (setq picon (assoc (list usr domains-tmp dir)
+ fnames))))
+ (pop domains-tmp))
+ (unless picon
+ (setq picon (assoc (list usr '("MISC") dir) fnames)))))
+ (push (setq cache (cons curkey (cdr picon)))
+ gnus-picons-url-alist)))
+ (if (and gnus-picons-display-as-address new-jobs)
+ (push (list sym-ann "@" right-p) new-jobs))
+ (push (list sym-ann 'picon (cdr cache) user right-p) new-jobs))
+ (if (and gnus-picons-display-as-address (not right-p))
+ (push (list sym-ann 'bar right-p) new-jobs))
+ ;; only put the jobs in the queue if this job has not been preempted.
+ (if (equal gnus-picons-job-already-running
+ (list sym-ann 'search user addrs dbs right-p))
+ (setq gnus-picons-jobs-alist
+ (nconc (if (and gnus-picons-display-as-address right-p)
+ (list (list sym-ann 'bar right-p)))
+ (nreverse new-jobs)
+ gnus-picons-jobs-alist)))
+ (gnus-picons-next-job-internal)))
+
+(defun gnus-picons-network-search-callback (user addrs dbs sym-ann right-p)
+ (gnus-picons-network-search-internal user addrs dbs sym-ann right-p
+ (prog1 (gnus-picons-parse-filenames)
+ (kill-buffer (current-buffer)))))
+
+(defun gnus-picons-network-search (user addrs dbs sym-ann right-p)
+ (let* ((host (mapconcat 'identity addrs "."))
+ (key (list (or user "unknown") host (if user
+ gnus-picons-user-directories
+ dbs)))
+ (cache (assoc key gnus-picons-url-alist)))
+ (if (null cache)
+ (gnus-picons-url-retrieve
+ (concat gnus-picons-piconsearch-url
+ "?user=" (w3-form-encode-xwfu (or user "unknown"))
+ "&host=" (w3-form-encode-xwfu host)
+ "&db=" (mapconcat 'w3-form-encode-xwfu
+ (if user
+ (append dbs
+ gnus-picons-user-directories)
+ dbs)
+ "+"))
+ 'gnus-picons-network-search-callback
+ (list user addrs dbs sym-ann right-p))
+ (gnus-picons-network-search-internal user addrs dbs sym-ann right-p))))
+
+;;; Main jobs dispatcher function
+
+(defun gnus-picons-next-job-internal ()
+ (if (setq gnus-picons-job-already-running (pop gnus-picons-jobs-alist))
+ (let* ((job gnus-picons-job-already-running)
+ (sym-ann (pop job))
+ (tag (pop job)))
+ (if tag
+ (cond ((stringp tag);; (SYM-ANN "..." RIGHT-P)
+ (gnus-picons-network-display-internal sym-ann nil tag
+ (pop job)))
+ ((eq 'bar tag)
+ (gnus-picons-network-display-internal
+ sym-ann (gnus-picons-try-face gnus-xmas-glyph-directory
+ "bar.")
+ nil (pop job)))
+ ((eq 'search tag);; (SYM-ANN 'search USER ADDRS DBS RIGHT-P)
+ (gnus-picons-network-search
+ (pop job) (pop job) (pop job) sym-ann (pop job)))
+ ((eq 'picon tag);; (SYM-ANN 'picon URL PART RIGHT-P)
+ (gnus-picons-network-display
+ (pop job) (pop job) sym-ann (pop job)))
+ (t (setq gnus-picons-job-already-running nil)
+ (error "Unknown picon job tag %s" tag)))))))
+
+(defun gnus-picons-next-job ()
+ "Start processing the job queue if it is not in progress"
+ (unless gnus-picons-job-already-running
+ (gnus-picons-next-job-internal)))
+
+(provide 'gnus-picon)
+
+;;; gnus-picon.el ends here
--- /dev/null
+;;; gnus-range.el --- range and sequence functions for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+;;; List and range functions
+
+(defun gnus-last-element (list)
+ "Return last element of LIST."
+ (while (cdr list)
+ (setq list (cdr list)))
+ (car list))
+
+(defun gnus-copy-sequence (list)
+ "Do a complete, total copy of a list."
+ (let (out)
+ (while (consp list)
+ (if (consp (car list))
+ (push (gnus-copy-sequence (pop list)) out)
+ (push (pop list) out)))
+ (if list
+ (nconc (nreverse out) list)
+ (nreverse out))))
+
+(defun gnus-set-difference (list1 list2)
+ "Return a list of elements of LIST1 that do not appear in LIST2."
+ (let ((list1 (copy-sequence list1)))
+ (while list2
+ (setq list1 (delq (car list2) list1))
+ (setq list2 (cdr list2)))
+ list1))
+
+(defun gnus-sorted-complement (list1 list2)
+ "Return a list of elements of LIST1 that do not appear in LIST2.
+Both lists have to be sorted over <."
+ (let (out)
+ (if (or (null list1) (null list2))
+ (or list1 list2)
+ (while (and list1 list2)
+ (cond ((= (car list1) (car list2))
+ (setq list1 (cdr list1)
+ list2 (cdr list2)))
+ ((< (car list1) (car list2))
+ (setq out (cons (car list1) out))
+ (setq list1 (cdr list1)))
+ (t
+ (setq out (cons (car list2) out))
+ (setq list2 (cdr list2)))))
+ (nconc (nreverse out) (or list1 list2)))))
+
+(defun gnus-intersection (list1 list2)
+ (let ((result nil))
+ (while list2
+ (when (memq (car list2) list1)
+ (setq result (cons (car list2) result)))
+ (setq list2 (cdr list2)))
+ result))
+
+(defun gnus-sorted-intersection (list1 list2)
+ ;; LIST1 and LIST2 have to be sorted over <.
+ (let (out)
+ (while (and list1 list2)
+ (cond ((= (car list1) (car list2))
+ (setq out (cons (car list1) out)
+ list1 (cdr list1)
+ list2 (cdr list2)))
+ ((< (car list1) (car list2))
+ (setq list1 (cdr list1)))
+ (t
+ (setq list2 (cdr list2)))))
+ (nreverse out)))
+
+(defun gnus-set-sorted-intersection (list1 list2)
+ ;; LIST1 and LIST2 have to be sorted over <.
+ ;; This function modifies LIST1.
+ (let* ((top (cons nil list1))
+ (prev top))
+ (while (and list1 list2)
+ (cond ((= (car list1) (car list2))
+ (setq prev list1
+ list1 (cdr list1)
+ list2 (cdr list2)))
+ ((< (car list1) (car list2))
+ (setcdr prev (cdr list1))
+ (setq list1 (cdr list1)))
+ (t
+ (setq list2 (cdr list2)))))
+ (setcdr prev nil)
+ (cdr top)))
+
+(defun gnus-compress-sequence (numbers &optional always-list)
+ "Convert list of numbers to a list of ranges or a single range.
+If ALWAYS-LIST is non-nil, this function will always release a list of
+ranges."
+ (let* ((first (car numbers))
+ (last (car numbers))
+ result)
+ (if (null numbers)
+ nil
+ (if (not (listp (cdr numbers)))
+ numbers
+ (while numbers
+ (cond ((= last (car numbers)) nil) ;Omit duplicated number
+ ((= (1+ last) (car numbers)) ;Still in sequence
+ (setq last (car numbers)))
+ (t ;End of one sequence
+ (setq result
+ (cons (if (= first last) first
+ (cons first last))
+ result))
+ (setq first (car numbers))
+ (setq last (car numbers))))
+ (setq numbers (cdr numbers)))
+ (if (and (not always-list) (null result))
+ (if (= first last) (list first) (cons first last))
+ (nreverse (cons (if (= first last) first (cons first last))
+ result)))))))
+
+(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
+(defun gnus-uncompress-range (ranges)
+ "Expand a list of ranges into a list of numbers.
+RANGES is either a single range on the form `(num . num)' or a list of
+these ranges."
+ (let (first last result)
+ (cond
+ ((null ranges)
+ nil)
+ ((not (listp (cdr ranges)))
+ (setq first (car ranges))
+ (setq last (cdr ranges))
+ (while (<= first last)
+ (setq result (cons first result))
+ (setq first (1+ first)))
+ (nreverse result))
+ (t
+ (while ranges
+ (if (atom (car ranges))
+ (when (numberp (car ranges))
+ (setq result (cons (car ranges) result)))
+ (setq first (caar ranges))
+ (setq last (cdar ranges))
+ (while (<= first last)
+ (setq result (cons first result))
+ (setq first (1+ first))))
+ (setq ranges (cdr ranges)))
+ (nreverse result)))))
+
+(defun gnus-add-to-range (ranges list)
+ "Return a list of ranges that has all articles from both RANGES and LIST.
+Note: LIST has to be sorted over `<'."
+ (if (not ranges)
+ (gnus-compress-sequence list t)
+ (setq list (copy-sequence list))
+ (unless (listp (cdr ranges))
+ (setq ranges (list ranges)))
+ (let ((out ranges)
+ ilist lowest highest temp)
+ (while (and ranges list)
+ (setq ilist list)
+ (setq lowest (or (and (atom (car ranges)) (car ranges))
+ (caar ranges)))
+ (while (and list (cdr list) (< (cadr list) lowest))
+ (setq list (cdr list)))
+ (when (< (car ilist) lowest)
+ (setq temp list)
+ (setq list (cdr list))
+ (setcdr temp nil)
+ (setq out (nconc (gnus-compress-sequence ilist t) out)))
+ (setq highest (or (and (atom (car ranges)) (car ranges))
+ (cdar ranges)))
+ (while (and list (<= (car list) highest))
+ (setq list (cdr list)))
+ (setq ranges (cdr ranges)))
+ (when list
+ (setq out (nconc (gnus-compress-sequence list t) out)))
+ (setq out (sort out (lambda (r1 r2)
+ (< (or (and (atom r1) r1) (car r1))
+ (or (and (atom r2) r2) (car r2))))))
+ (setq ranges out)
+ (while ranges
+ (if (atom (car ranges))
+ (when (cdr ranges)
+ (if (atom (cadr ranges))
+ (when (= (1+ (car ranges)) (cadr ranges))
+ (setcar ranges (cons (car ranges)
+ (cadr ranges)))
+ (setcdr ranges (cddr ranges)))
+ (when (= (1+ (car ranges)) (caadr ranges))
+ (setcar (cadr ranges) (car ranges))
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges)))))
+ (when (cdr ranges)
+ (if (atom (cadr ranges))
+ (when (= (1+ (cdar ranges)) (cadr ranges))
+ (setcdr (car ranges) (cadr ranges))
+ (setcdr ranges (cddr ranges)))
+ (when (= (1+ (cdar ranges)) (caadr ranges))
+ (setcdr (car ranges) (cdadr ranges))
+ (setcdr ranges (cddr ranges))))))
+ (setq ranges (cdr ranges)))
+ out)))
+
+(defun gnus-remove-from-range (ranges list)
+ "Return a list of ranges that has all articles from LIST removed from RANGES.
+Note: LIST has to be sorted over `<'."
+ ;; !!! This function shouldn't look like this, but I've got a headache.
+ (gnus-compress-sequence
+ (gnus-sorted-complement
+ (gnus-uncompress-range ranges) list)))
+
+(defun gnus-member-of-range (number ranges)
+ (if (not (listp (cdr ranges)))
+ (and (>= number (car ranges))
+ (<= number (cdr ranges)))
+ (let ((not-stop t))
+ (while (and ranges
+ (if (numberp (car ranges))
+ (>= number (car ranges))
+ (>= number (caar ranges)))
+ not-stop)
+ (when (if (numberp (car ranges))
+ (= number (car ranges))
+ (and (>= number (caar ranges))
+ (<= number (cdar ranges))))
+ (setq not-stop nil))
+ (setq ranges (cdr ranges)))
+ (not not-stop))))
+
+(defun gnus-range-length (range)
+ "Return the length RANGE would have if uncompressed."
+ (length (gnus-uncompress-range range)))
+
+(defun gnus-sublist-p (list sublist)
+ "Test whether all elements in SUBLIST are members of LIST."
+ (let ((sublistp t))
+ (while sublist
+ (unless (memq (pop sublist) list)
+ (setq sublistp nil
+ sublist nil)))
+ sublistp))
+
+(defun gnus-range-add (range1 range2)
+ "Add RANGE2 to RANGE1 destructively."
+ (cond
+ ;; If either are nil, then the job is quite easy.
+ ((or (null range1) (null range2))
+ (or range1 range2))
+ (t
+ ;; I don't like thinking.
+ (gnus-compress-sequence
+ (sort
+ (nconc
+ (gnus-uncompress-range range1)
+ (gnus-uncompress-range range2))
+ '<)))))
+
+(provide 'gnus-range)
+
+;;; gnus-range.el ends here
--- /dev/null
+;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+;; 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-sum)
+
+;;;
+;;; gnus-pick-mode
+;;;
+
+(defvar gnus-pick-mode nil
+ "Minor mode for providing a pick-and-read interface in Gnus summary buffers.")
+
+(defcustom gnus-pick-display-summary nil
+ "*Display summary while reading."
+ :type 'boolean
+ :group 'gnus-summary-pick)
+
+(defcustom gnus-pick-mode-hook nil
+ "Hook run in summary pick mode buffers."
+ :type 'hook
+ :group 'gnus-summary-pick)
+
+(defcustom gnus-mark-unpicked-articles-as-read nil
+ "*If non-nil, mark all unpicked articles as read."
+ :type 'boolean
+ :group 'gnus-summary-pick)
+
+(defcustom gnus-pick-elegant-flow t
+ "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked."
+ :type 'boolean
+ :group 'gnus-summary-pick)
+
+(defcustom gnus-summary-pick-line-format
+ "%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ "*The format specification of the lines in pick buffers.
+It accepts the same format specs that `gnus-summary-line-format' does."
+ :type 'string
+ :group 'gnus-summary-pick)
+
+;;; Internal variables.
+
+(defvar gnus-pick-mode-map nil)
+
+(unless gnus-pick-mode-map
+ (setq gnus-pick-mode-map (make-sparse-keymap))
+
+ (gnus-define-keys gnus-pick-mode-map
+ "t" gnus-uu-mark-thread
+ "T" gnus-uu-unmark-thread
+ " " gnus-pick-next-page
+ "u" gnus-summary-unmark-as-processable
+ "U" gnus-summary-unmark-all-processable
+ "v" gnus-uu-mark-over
+ "r" gnus-uu-mark-region
+ "R" gnus-uu-unmark-region
+ "e" gnus-uu-mark-by-regexp
+ "E" gnus-uu-mark-by-regexp
+ "b" gnus-uu-mark-buffer
+ "B" gnus-uu-unmark-buffer
+ "." gnus-pick-article
+ gnus-down-mouse-2 gnus-pick-mouse-pick-region
+ ;;gnus-mouse-2 gnus-pick-mouse-pick
+ "X" gnus-pick-start-reading
+ "\r" gnus-pick-start-reading))
+
+(defun gnus-pick-make-menu-bar ()
+ (unless (boundp 'gnus-pick-menu)
+ (easy-menu-define
+ gnus-pick-menu gnus-pick-mode-map ""
+ '("Pick"
+ ("Pick"
+ ["Article" gnus-summary-mark-as-processable t]
+ ["Thread" gnus-uu-mark-thread t]
+ ["Region" gnus-uu-mark-region t]
+ ["Regexp" gnus-uu-mark-regexp t]
+ ["Buffer" gnus-uu-mark-buffer t])
+ ("Unpick"
+ ["Article" gnus-summary-unmark-as-processable t]
+ ["Thread" gnus-uu-unmark-thread t]
+ ["Region" gnus-uu-unmark-region t]
+ ["Regexp" gnus-uu-unmark-regexp t]
+ ["Buffer" gnus-uu-unmark-buffer t])
+ ["Start reading" gnus-pick-start-reading t]
+ ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
+
+(defun gnus-pick-mode (&optional arg)
+ "Minor mode for providing a pick-and-read interface in Gnus summary buffers.
+
+\\{gnus-pick-mode-map}"
+ (interactive "P")
+ (when (eq major-mode 'gnus-summary-mode)
+ (if (not (set (make-local-variable 'gnus-pick-mode)
+ (if (null arg) (not gnus-pick-mode)
+ (> (prefix-numeric-value arg) 0))))
+ (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
+ ;; Make sure that we don't select any articles upon group entry.
+ (set (make-local-variable 'gnus-auto-select-first) nil)
+ ;; Change line format.
+ (setq gnus-summary-line-format gnus-summary-pick-line-format)
+ (setq gnus-summary-line-format-spec nil)
+ (gnus-update-format-specifications nil 'summary)
+ (gnus-update-summary-mark-positions)
+ (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
+ (set (make-local-variable 'gnus-summary-goto-unread) 'never)
+ ;; Set up the menu.
+ (when (gnus-visual-p 'pick-menu 'menu)
+ (gnus-pick-make-menu-bar))
+ (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map)
+ (run-hooks 'gnus-pick-mode-hook))))
+
+(defun gnus-pick-setup-message ()
+ "Make Message do the right thing on exit."
+ (when (and (gnus-buffer-live-p gnus-summary-buffer)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-pick-mode))
+ (message-add-action
+ '(gnus-configure-windows 'pick t) 'send 'exit 'postpone 'kill)))
+
+(defvar gnus-pick-line-number 1)
+(defun gnus-pick-line-number ()
+ "Return the current line number."
+ (if (bobp)
+ (setq gnus-pick-line-number 1)
+ (incf gnus-pick-line-number)))
+
+(defun gnus-pick-start-reading (&optional catch-up)
+ "Start reading the picked articles.
+If given a prefix, mark all unpicked articles as read."
+ (interactive "P")
+ (if gnus-newsgroup-processable
+ (progn
+ (gnus-summary-limit-to-articles nil)
+ (when (or catch-up gnus-mark-unpicked-articles-as-read)
+ (gnus-summary-limit-mark-excluded-as-read))
+ (gnus-summary-first-article)
+ (gnus-configure-windows
+ (if gnus-pick-display-summary 'article 'pick) t))
+ (if gnus-pick-elegant-flow
+ (progn
+ (when (or catch-up gnus-mark-unpicked-articles-as-read)
+ (gnus-summary-catchup nil t))
+ (if (gnus-group-quit-config gnus-newsgroup-name)
+ (gnus-summary-exit)
+ (gnus-summary-next-group)))
+ (error "No articles have been picked"))))
+
+(defun gnus-pick-article (&optional arg)
+ "Pick the article on the current line.
+If ARG, pick the article on that line instead."
+ (interactive "P")
+ (when arg
+ (let (pos)
+ (save-excursion
+ (goto-char (point-min))
+ (when (zerop (forward-line (1- (prefix-numeric-value arg))))
+ (setq pos (point))))
+ (if (not pos)
+ (gnus-error 2 "No such line: %s" arg)
+ (goto-char pos))))
+ (gnus-summary-mark-as-processable 1))
+
+(defun gnus-pick-mouse-pick (e)
+ (interactive "e")
+ (mouse-set-point e)
+ (save-excursion
+ (gnus-summary-mark-as-processable 1)))
+
+(defun gnus-pick-mouse-pick-region (start-event)
+ "Pick articles that the mouse is dragged over.
+This must be bound to a button-down mouse event."
+ (interactive "e")
+ (mouse-minibuffer-check start-event)
+ (let* ((echo-keystrokes 0)
+ (start-posn (event-start start-event))
+ (start-point (posn-point start-posn))
+ (start-line (1+ (count-lines 1 start-point)))
+ (start-window (posn-window start-posn))
+ (start-frame (window-frame start-window))
+ (bounds (window-edges start-window))
+ (top (nth 1 bounds))
+ (bottom (if (window-minibuffer-p start-window)
+ (nth 3 bounds)
+ ;; Don't count the mode line.
+ (1- (nth 3 bounds))))
+ (click-count (1- (event-click-count start-event))))
+ (setq mouse-selection-click-count click-count)
+ (setq mouse-selection-click-count-buffer (current-buffer))
+ (mouse-set-point start-event)
+ ;; In case the down click is in the middle of some intangible text,
+ ;; use the end of that text, and put it in START-POINT.
+ (when (< (point) start-point)
+ (goto-char start-point))
+ (gnus-pick-article)
+ (setq start-point (point))
+ ;; end-of-range is used only in the single-click case.
+ ;; It is the place where the drag has reached so far
+ ;; (but not outside the window where the drag started).
+ (let (event end end-point last-end-point (end-of-range (point)))
+ (track-mouse
+ (while (progn
+ (setq event (read-event))
+ (or (mouse-movement-p event)
+ (eq (car-safe event) 'switch-frame)))
+ (if (eq (car-safe event) 'switch-frame)
+ nil
+ (setq end (event-end event)
+ end-point (posn-point end))
+ (when end-point
+ (setq last-end-point end-point))
+
+ (cond
+ ;; Are we moving within the original window?
+ ((and (eq (posn-window end) start-window)
+ (integer-or-marker-p end-point))
+ ;; Go to START-POINT first, so that when we move to END-POINT,
+ ;; if it's in the middle of intangible text,
+ ;; point jumps in the direction away from START-POINT.
+ (goto-char start-point)
+ (goto-char end-point)
+ (gnus-pick-article)
+ ;; In case the user moved his mouse really fast, pick
+ ;; articles on the line between this one and the last one.
+ (let* ((this-line (1+ (count-lines 1 end-point)))
+ (min-line (min this-line start-line))
+ (max-line (max this-line start-line)))
+ (while (< min-line max-line)
+ (goto-line min-line)
+ (gnus-pick-article)
+ (setq min-line (1+ min-line)))
+ (setq start-line this-line))
+ (when (zerop (% click-count 3))
+ (setq end-of-range (point))))
+ (t
+ (let ((mouse-row (cdr (cdr (mouse-position)))))
+ (cond
+ ((null mouse-row))
+ ((< mouse-row top)
+ (mouse-scroll-subr start-window (- mouse-row top)))
+ ((>= mouse-row bottom)
+ (mouse-scroll-subr start-window
+ (1+ (- mouse-row bottom)))))))))))
+ (when (consp event)
+ (let ((fun (key-binding (vector (car event)))))
+ ;; Run the binding of the terminating up-event, if possible.
+ ;; In the case of a multiple click, it gives the wrong results,
+ ;; because it would fail to set up a region.
+ (when nil
+ ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
+ ;; In this case, we can just let the up-event execute normally.
+ (let ((end (event-end event)))
+ ;; Set the position in the event before we replay it,
+ ;; because otherwise it may have a position in the wrong
+ ;; buffer.
+ (setcar (cdr end) end-of-range)
+ ;; Delete the overlay before calling the function,
+ ;; because delete-overlay increases buffer-modified-tick.
+ (push event unread-command-events))))))))
+
+(defun gnus-pick-next-page ()
+ "Go to the next page. If at the end of the buffer, start reading articles."
+ (interactive)
+ (let ((scroll-in-place nil))
+ (condition-case nil
+ (scroll-up)
+ (end-of-buffer (gnus-pick-start-reading)))))
+
+;;;
+;;; gnus-binary-mode
+;;;
+
+(defvar gnus-binary-mode nil
+ "Minor mode for providing a binary group interface in Gnus summary buffers.")
+
+(defvar gnus-binary-mode-hook nil
+ "Hook run in summary binary mode buffers.")
+
+(defvar gnus-binary-mode-map nil)
+
+(unless gnus-binary-mode-map
+ (setq gnus-binary-mode-map (make-sparse-keymap))
+
+ (gnus-define-keys
+ gnus-binary-mode-map
+ "g" gnus-binary-show-article))
+
+(defun gnus-binary-make-menu-bar ()
+ (unless (boundp 'gnus-binary-menu)
+ (easy-menu-define
+ gnus-binary-menu gnus-binary-mode-map ""
+ '("Pick"
+ ["Switch binary mode off" gnus-binary-mode t]))))
+
+(defun gnus-binary-mode (&optional arg)
+ "Minor mode for providing a binary group interface in Gnus summary buffers."
+ (interactive "P")
+ (when (eq major-mode 'gnus-summary-mode)
+ (make-local-variable 'gnus-binary-mode)
+ (setq gnus-binary-mode
+ (if (null arg) (not gnus-binary-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (when gnus-binary-mode
+ ;; Make sure that we don't select any articles upon group entry.
+ (make-local-variable 'gnus-auto-select-first)
+ (setq gnus-auto-select-first nil)
+ (make-local-variable 'gnus-summary-display-article-function)
+ (setq gnus-summary-display-article-function 'gnus-binary-display-article)
+ ;; Set up the menu.
+ (when (gnus-visual-p 'binary-menu 'menu)
+ (gnus-binary-make-menu-bar))
+ (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map)
+ (run-hooks 'gnus-binary-mode-hook))))
+
+(defun gnus-binary-display-article (article &optional all-header)
+ "Run ARTICLE through the binary decode functions."
+ (when (gnus-summary-goto-subject article)
+ (let ((gnus-view-pseudos 'automatic))
+ (gnus-uu-decode-uu))))
+
+(defun gnus-binary-show-article (&optional arg)
+ "Bypass the binary functions and show the article."
+ (interactive "P")
+ (let (gnus-summary-display-article-function)
+ (gnus-summary-show-article arg)))
+
+;;;
+;;; gnus-tree-mode
+;;;
+
+(defcustom gnus-tree-line-format "%(%[%3,3n%]%)"
+ "Format of tree elements."
+ :type 'string
+ :group 'gnus-summary-tree)
+
+(defcustom gnus-tree-minimize-window t
+ "If non-nil, minimize the tree buffer window.
+If a number, never let the tree buffer grow taller than that number of
+lines."
+ :type 'boolean
+ :group 'gnus-summary-tree)
+
+(defcustom gnus-selected-tree-face 'modeline
+ "*Face used for highlighting selected articles in the thread tree."
+ :type 'face
+ :group 'gnus-summary-tree)
+
+(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\))
+ (?\{ . ?\}) (?< . ?>))
+ "Brackets used in tree nodes.")
+
+(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
+ "Characters used to connect parents with children.")
+
+(defcustom gnus-tree-mode-line-format "Gnus: %%b %S %Z"
+ "*The format specification for the tree mode line."
+ :type 'string
+ :group 'gnus-summary-tree)
+
+(defcustom gnus-generate-tree-function 'gnus-generate-vertical-tree
+ "*Function for generating a thread tree.
+Two predefined functions are available:
+`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'."
+ :type '(radio (function-item gnus-generate-vertical-tree)
+ (function-item gnus-generate-horizontal-tree)
+ (function :tag "Other" nil))
+ :group 'gnus-summary-tree)
+
+(defcustom gnus-tree-mode-hook nil
+ "*Hook run in tree mode buffers."
+ :type 'hook
+ :group 'gnus-summary-tree)
+
+;;; Internal variables.
+
+(defvar gnus-tree-line-format-alist
+ `((?n gnus-tmp-name ?s)
+ (?f gnus-tmp-from ?s)
+ (?N gnus-tmp-number ?d)
+ (?\[ gnus-tmp-open-bracket ?c)
+ (?\] gnus-tmp-close-bracket ?c)
+ (?s gnus-tmp-subject ?s)))
+
+(defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist)
+
+(defvar gnus-tree-mode-line-format-spec nil)
+(defvar gnus-tree-line-format-spec nil)
+
+(defvar gnus-tree-node-length nil)
+(defvar gnus-selected-tree-overlay nil)
+
+(defvar gnus-tree-displayed-thread nil)
+
+(defvar gnus-tree-mode-map nil)
+(put 'gnus-tree-mode 'mode-class 'special)
+
+(unless gnus-tree-mode-map
+ (setq gnus-tree-mode-map (make-keymap))
+ (suppress-keymap gnus-tree-mode-map)
+ (gnus-define-keys
+ gnus-tree-mode-map
+ "\r" gnus-tree-select-article
+ gnus-mouse-2 gnus-tree-pick-article
+ "\C-?" gnus-tree-read-summary-keys
+ "h" gnus-tree-show-summary
+
+ "\C-c\C-i" gnus-info-find-node)
+
+ (substitute-key-definition
+ 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
+
+(defun gnus-tree-make-menu-bar ()
+ (unless (boundp 'gnus-tree-menu)
+ (easy-menu-define
+ gnus-tree-menu gnus-tree-mode-map ""
+ '("Tree"
+ ["Select article" gnus-tree-select-article t]))))
+
+(defun gnus-tree-mode ()
+ "Major mode for displaying thread trees."
+ (interactive)
+ (gnus-set-format 'tree-mode)
+ (gnus-set-format 'tree t)
+ (when (gnus-visual-p 'tree-menu 'menu)
+ (gnus-tree-make-menu-bar))
+ (kill-all-local-variables)
+ (gnus-simplify-mode-line)
+ (setq mode-name "Tree")
+ (setq major-mode 'gnus-tree-mode)
+ (use-local-map gnus-tree-mode-map)
+ (buffer-disable-undo (current-buffer))
+ (setq buffer-read-only t)
+ (setq truncate-lines t)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (gnus-tree-node-insert (make-mail-header "") nil)
+ (setq gnus-tree-node-length (1- (point))))
+ (run-hooks 'gnus-tree-mode-hook))
+
+(defun gnus-tree-read-summary-keys (&optional arg)
+ "Read a summary buffer key sequence and execute it."
+ (interactive "P")
+ (let ((buf (current-buffer))
+ win)
+ (gnus-article-read-summary-keys arg nil t)
+ (when (setq win (get-buffer-window buf))
+ (select-window win)
+ (when gnus-selected-tree-overlay
+ (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
+ (gnus-tree-minimize))))
+
+(defun gnus-tree-show-summary ()
+ "Reconfigure windows to show summary buffer."
+ (interactive)
+ (if (not (gnus-buffer-live-p gnus-summary-buffer))
+ (error "There is no summary buffer for this tree buffer")
+ (gnus-configure-windows 'article)
+ (gnus-summary-goto-subject gnus-current-article)))
+
+(defun gnus-tree-select-article (article)
+ "Select the article under point, if any."
+ (interactive (list (gnus-tree-article-number)))
+ (let ((buf (current-buffer)))
+ (when article
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-goto-article article))
+ (select-window (get-buffer-window buf)))))
+
+(defun gnus-tree-pick-article (e)
+ "Select the article under the mouse pointer."
+ (interactive "e")
+ (mouse-set-point e)
+ (gnus-tree-select-article (gnus-tree-article-number)))
+
+(defun gnus-tree-article-number ()
+ (get-text-property (point) 'gnus-number))
+
+(defun gnus-tree-article-region (article)
+ "Return a cons with BEG and END of the article region."
+ (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article)))
+ (when pos
+ (cons pos (next-single-property-change pos 'gnus-number)))))
+
+(defun gnus-tree-goto-article (article)
+ (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article)))
+ (when pos
+ (goto-char pos))))
+
+(defun gnus-tree-recenter ()
+ "Center point in the tree window."
+ (let ((selected (selected-window))
+ (tree-window (get-buffer-window gnus-tree-buffer t)))
+ (when tree-window
+ (select-window tree-window)
+ (when gnus-selected-tree-overlay
+ (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
+ (let* ((top (cond ((< (window-height) 4) 0)
+ ((< (window-height) 7) 1)
+ (t 2)))
+ (height (1- (window-height)))
+ (bottom (save-excursion (goto-char (point-max))
+ (forward-line (- height))
+ (point))))
+ ;; Set the window start to either `bottom', which is the biggest
+ ;; possible valid number, or the second line from the top,
+ ;; whichever is the least.
+ (set-window-start
+ tree-window (min bottom (save-excursion
+ (forward-line (- top)) (point)))))
+ (select-window selected))))
+
+(defun gnus-get-tree-buffer ()
+ "Return the tree buffer properly initialized."
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-tree-buffer))
+ (unless (eq major-mode 'gnus-tree-mode)
+ (gnus-add-current-to-buffer-list)
+ (gnus-tree-mode))
+ (current-buffer)))
+
+(defun gnus-tree-minimize ()
+ (when (and gnus-tree-minimize-window
+ (not (one-window-p)))
+ (let ((windows 0)
+ tot-win-height)
+ (walk-windows (lambda (window) (incf windows)))
+ (setq tot-win-height
+ (- (frame-height)
+ (* window-min-height (1- windows))
+ 2))
+ (let* ((window-min-height 2)
+ (height (count-lines (point-min) (point-max)))
+ (min (max (1- window-min-height) height))
+ (tot (if (numberp gnus-tree-minimize-window)
+ (min gnus-tree-minimize-window min)
+ min))
+ (win (get-buffer-window (current-buffer)))
+ (wh (and win (1- (window-height win)))))
+ (setq tot (min tot tot-win-height))
+ (when (and win
+ (not (eq tot wh)))
+ (let ((selected (selected-window)))
+ (when (ignore-errors (select-window win))
+ (enlarge-window (- tot wh))
+ (select-window selected))))))))
+
+;;; Generating the tree.
+
+(defun gnus-tree-node-insert (header sparse &optional adopted)
+ (let* ((dummy (stringp header))
+ (header (if (vectorp header) header
+ (progn
+ (setq header (make-mail-header "*****"))
+ (mail-header-set-number header 0)
+ (mail-header-set-lines header 0)
+ (mail-header-set-chars header 0)
+ header)))
+ (gnus-tmp-from (mail-header-from header))
+ (gnus-tmp-subject (mail-header-subject header))
+ (gnus-tmp-number (mail-header-number header))
+ (gnus-tmp-name
+ (cond
+ ((string-match "(.+)" gnus-tmp-from)
+ (substring gnus-tmp-from
+ (1+ (match-beginning 0)) (1- (match-end 0))))
+ ((string-match "<[^>]+> *$" gnus-tmp-from)
+ (let ((beg (match-beginning 0)))
+ (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
+ (substring gnus-tmp-from (1+ (match-beginning 0))
+ (1- (match-end 0))))
+ (substring gnus-tmp-from 0 beg))))
+ ((memq gnus-tmp-number sparse)
+ "***")
+ (t gnus-tmp-from)))
+ (gnus-tmp-open-bracket
+ (cond ((memq gnus-tmp-number sparse)
+ (caadr gnus-tree-brackets))
+ (dummy (caaddr gnus-tree-brackets))
+ (adopted (car (nth 3 gnus-tree-brackets)))
+ (t (caar gnus-tree-brackets))))
+ (gnus-tmp-close-bracket
+ (cond ((memq gnus-tmp-number sparse)
+ (cdadr gnus-tree-brackets))
+ (adopted (cdr (nth 3 gnus-tree-brackets)))
+ (dummy
+ (cdaddr gnus-tree-brackets))
+ (t (cdar gnus-tree-brackets))))
+ (buffer-read-only nil)
+ beg end)
+ (gnus-add-text-properties
+ (setq beg (point))
+ (setq end (progn (eval gnus-tree-line-format-spec) (point)))
+ (list 'gnus-number gnus-tmp-number))
+ (when (or t (gnus-visual-p 'tree-highlight 'highlight))
+ (gnus-tree-highlight-node gnus-tmp-number beg end))))
+
+(defun gnus-tree-highlight-node (article beg end)
+ "Highlight current line according to `gnus-summary-highlight'."
+ (let ((list gnus-summary-highlight)
+ face)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let* ((score (or (cdr (assq article gnus-newsgroup-scored))
+ gnus-summary-default-score 0))
+ (default gnus-summary-default-score)
+ (mark (or (gnus-summary-article-mark article) gnus-unread-mark)))
+ ;; Eval the cars of the lists until we find a match.
+ (while (and list
+ (not (eval (caar list))))
+ (setq list (cdr list)))))
+ (unless (eq (setq face (cdar list)) (get-text-property beg 'face))
+ (gnus-put-text-property
+ beg end 'face
+ (if (boundp face) (symbol-value face) face)))))
+
+(defun gnus-tree-indent (level)
+ (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? )))
+
+(defvar gnus-tmp-limit)
+(defvar gnus-tmp-sparse)
+(defvar gnus-tmp-indent)
+
+(defun gnus-generate-tree (thread)
+ "Generate a thread tree for THREAD."
+ (save-excursion
+ (set-buffer (gnus-get-tree-buffer))
+ (let ((buffer-read-only nil)
+ (gnus-tmp-indent 0))
+ (erase-buffer)
+ (funcall gnus-generate-tree-function thread 0)
+ (gnus-set-mode-line 'tree)
+ (goto-char (point-min))
+ (gnus-tree-minimize)
+ (gnus-tree-recenter)
+ (let ((selected (selected-window)))
+ (when (get-buffer-window (set-buffer gnus-tree-buffer) t)
+ (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+ (gnus-horizontal-recenter)
+ (select-window selected))))))
+
+(defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted)
+ "Generate a horizontal tree."
+ (let* ((dummy (stringp (car thread)))
+ (do (or dummy
+ (and (car thread)
+ (memq (mail-header-number (car thread))
+ gnus-tmp-limit))))
+ col beg)
+ (if (not do)
+ ;; We don't want this article.
+ (setq thread (cdr thread))
+ (if (not (bolp))
+ ;; Not the first article on the line, so we insert a "-".
+ (insert (car gnus-tree-parent-child-edges))
+ ;; If the level isn't zero, then we insert some indentation.
+ (unless (zerop level)
+ (gnus-tree-indent level)
+ (insert (cadr gnus-tree-parent-child-edges))
+ (setq col (- (setq beg (point)) (gnus-point-at-bol) 1))
+ ;; Draw "|" lines upwards.
+ (while (progn
+ (forward-line -1)
+ (forward-char col)
+ (= (following-char) ? ))
+ (delete-char 1)
+ (insert (caddr gnus-tree-parent-child-edges)))
+ (goto-char beg)))
+ (setq dummyp nil)
+ ;; Insert the article node.
+ (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted))
+ (if (null thread)
+ ;; End of the thread, so we go to the next line.
+ (unless (bolp)
+ (insert "\n"))
+ ;; Recurse downwards in all children of this article.
+ (while thread
+ (gnus-generate-horizontal-tree
+ (pop thread) (if do (1+ level) level)
+ (or dummyp dummy) dummy)))))
+
+(defsubst gnus-tree-indent-vertical ()
+ (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent)
+ (- (point) (gnus-point-at-bol)))))
+ (when (> len 0)
+ (insert (make-string len ? )))))
+
+(defsubst gnus-tree-forward-line (n)
+ (while (>= (decf n) 0)
+ (unless (zerop (forward-line 1))
+ (end-of-line)
+ (insert "\n")))
+ (end-of-line))
+
+(defun gnus-generate-vertical-tree (thread level &optional dummyp adopted)
+ "Generate a vertical tree."
+ (let* ((dummy (stringp (car thread)))
+ (do (or dummy
+ (and (car thread)
+ (memq (mail-header-number (car thread))
+ gnus-tmp-limit))))
+ beg)
+ (if (not do)
+ ;; We don't want this article.
+ (setq thread (cdr thread))
+ (if (not (save-excursion (beginning-of-line) (bobp)))
+ ;; Not the first article on the line, so we insert a "-".
+ (progn
+ (gnus-tree-indent-vertical)
+ (insert (make-string (/ gnus-tree-node-length 2) ? ))
+ (insert (caddr gnus-tree-parent-child-edges))
+ (gnus-tree-forward-line 1))
+ ;; If the level isn't zero, then we insert some indentation.
+ (unless (zerop gnus-tmp-indent)
+ (gnus-tree-forward-line (1- (* 2 level)))
+ (gnus-tree-indent-vertical)
+ (delete-char -1)
+ (insert (cadr gnus-tree-parent-child-edges))
+ (setq beg (point))
+ (forward-char -1)
+ ;; Draw "-" lines leftwards.
+ (while (= (char-after (1- (point))) ? )
+ (delete-char -1)
+ (insert (car gnus-tree-parent-child-edges))
+ (forward-char -1))
+ (goto-char beg)
+ (gnus-tree-forward-line 1)))
+ (setq dummyp nil)
+ ;; Insert the article node.
+ (gnus-tree-indent-vertical)
+ (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)
+ (gnus-tree-forward-line 1))
+ (if (null thread)
+ ;; End of the thread, so we go to the next line.
+ (progn
+ (goto-char (point-min))
+ (end-of-line)
+ (incf gnus-tmp-indent))
+ ;; Recurse downwards in all children of this article.
+ (while thread
+ (gnus-generate-vertical-tree
+ (pop thread) (if do (1+ level) level)
+ (or dummyp dummy) dummy)))))
+
+;;; Interface functions.
+
+(defun gnus-possibly-generate-tree (article &optional force)
+ "Generate the thread tree for ARTICLE if it isn't displayed already."
+ (when (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (and gnus-use-trees
+ gnus-show-threads
+ (vectorp (gnus-summary-article-header article))))
+ (save-excursion
+ (let ((top (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-cut-thread
+ (gnus-remove-thread
+ (mail-header-id
+ (gnus-summary-article-header article))
+ t))))
+ (gnus-tmp-limit gnus-newsgroup-limit)
+ (gnus-tmp-sparse gnus-newsgroup-sparse))
+ (when (or force
+ (not (eq top gnus-tree-displayed-thread)))
+ (gnus-generate-tree top)
+ (setq gnus-tree-displayed-thread top))))))
+
+(defun gnus-tree-open (group)
+ (gnus-get-tree-buffer))
+
+(defun gnus-tree-close (group)
+ ;(gnus-kill-buffer gnus-tree-buffer)
+ )
+
+(defun gnus-highlight-selected-tree (article)
+ "Highlight the selected article in the tree."
+ (let ((buf (current-buffer))
+ region)
+ (set-buffer gnus-tree-buffer)
+ (when (setq region (gnus-tree-article-region article))
+ (when (or (not gnus-selected-tree-overlay)
+ (gnus-extent-detached-p gnus-selected-tree-overlay))
+ ;; Create a new overlay.
+ (gnus-overlay-put
+ (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2))
+ 'face gnus-selected-tree-face))
+ ;; Move the overlay to the article.
+ (gnus-move-overlay
+ gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
+ (gnus-tree-minimize)
+ (gnus-tree-recenter)
+ (let ((selected (selected-window)))
+ (when (get-buffer-window (set-buffer gnus-tree-buffer) t)
+ (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+ (gnus-horizontal-recenter)
+ (select-window selected))))
+ ;; If we remove this save-excursion, it updates the wrong mode lines?!?
+ (save-excursion
+ (set-buffer gnus-tree-buffer)
+ (gnus-set-mode-line 'tree))
+ (set-buffer buf)))
+
+(defun gnus-tree-highlight-article (article face)
+ (save-excursion
+ (set-buffer (gnus-get-tree-buffer))
+ (let (region)
+ (when (setq region (gnus-tree-article-region article))
+ (gnus-put-text-property (car region) (cdr region) 'face face)
+ (set-window-point
+ (get-buffer-window (current-buffer) t) (cdr region))))))
+
+;;;
+;;; gnus-carpal
+;;;
+
+(defvar gnus-carpal-group-buffer-buttons
+ '(("next" . gnus-group-next-unread-group)
+ ("prev" . gnus-group-prev-unread-group)
+ ("read" . gnus-group-read-group)
+ ("select" . gnus-group-select-group)
+ ("catch-up" . gnus-group-catchup-current)
+ ("new-news" . gnus-group-get-new-news-this-group)
+ ("toggle-sub" . gnus-group-unsubscribe-current-group)
+ ("subscribe" . gnus-group-unsubscribe-group)
+ ("kill" . gnus-group-kill-group)
+ ("yank" . gnus-group-yank-group)
+ ("describe" . gnus-group-describe-group)
+ "list"
+ ("subscribed" . gnus-group-list-groups)
+ ("all" . gnus-group-list-all-groups)
+ ("killed" . gnus-group-list-killed)
+ ("zombies" . gnus-group-list-zombies)
+ ("matching" . gnus-group-list-matching)
+ ("post" . gnus-group-post-news)
+ ("mail" . gnus-group-mail)
+ ("rescan" . gnus-group-get-new-news)
+ ("browse-foreign" . gnus-group-browse-foreign)
+ ("exit" . gnus-group-exit)))
+
+(defvar gnus-carpal-summary-buffer-buttons
+ '("mark"
+ ("read" . gnus-summary-mark-as-read-forward)
+ ("tick" . gnus-summary-tick-article-forward)
+ ("clear" . gnus-summary-clear-mark-forward)
+ ("expirable" . gnus-summary-mark-as-expirable)
+ "move"
+ ("scroll" . gnus-summary-next-page)
+ ("next-unread" . gnus-summary-next-unread-article)
+ ("prev-unread" . gnus-summary-prev-unread-article)
+ ("first" . gnus-summary-first-unread-article)
+ ("best" . gnus-summary-best-unread-article)
+ "article"
+ ("headers" . gnus-summary-toggle-header)
+ ("uudecode" . gnus-uu-decode-uu)
+ ("enter-digest" . gnus-summary-enter-digest-group)
+ ("fetch-parent" . gnus-summary-refer-parent-article)
+ "mail"
+ ("move" . gnus-summary-move-article)
+ ("copy" . gnus-summary-copy-article)
+ ("respool" . gnus-summary-respool-article)
+ "threads"
+ ("lower" . gnus-summary-lower-thread)
+ ("kill" . gnus-summary-kill-thread)
+ "post"
+ ("post" . gnus-summary-post-news)
+ ("mail" . gnus-summary-mail)
+ ("followup" . gnus-summary-followup-with-original)
+ ("reply" . gnus-summary-reply-with-original)
+ ("cancel" . gnus-summary-cancel-article)
+ "misc"
+ ("exit" . gnus-summary-exit)
+ ("fed-up" . gnus-summary-catchup-and-goto-next-group)))
+
+(defvar gnus-carpal-server-buffer-buttons
+ '(("add" . gnus-server-add-server)
+ ("browse" . gnus-server-browse-server)
+ ("list" . gnus-server-list-servers)
+ ("kill" . gnus-server-kill-server)
+ ("yank" . gnus-server-yank-server)
+ ("copy" . gnus-server-copy-server)
+ ("exit" . gnus-server-exit)))
+
+(defvar gnus-carpal-browse-buffer-buttons
+ '(("subscribe" . gnus-browse-unsubscribe-current-group)
+ ("exit" . gnus-browse-exit)))
+
+(defvar gnus-carpal-group-buffer "*Carpal Group*")
+(defvar gnus-carpal-summary-buffer "*Carpal Summary*")
+(defvar gnus-carpal-server-buffer "*Carpal Server*")
+(defvar gnus-carpal-browse-buffer "*Carpal Browse*")
+
+(defvar gnus-carpal-attached-buffer nil)
+
+(defvar gnus-carpal-mode-hook nil
+ "*Hook run in carpal mode buffers.")
+
+(defvar gnus-carpal-button-face 'bold
+ "*Face used on carpal buttons.")
+
+(defvar gnus-carpal-header-face 'bold-italic
+ "*Face used on carpal buffer headers.")
+
+(defvar gnus-carpal-mode-map nil)
+(put 'gnus-carpal-mode 'mode-class 'special)
+
+(if gnus-carpal-mode-map
+ nil
+ (setq gnus-carpal-mode-map (make-keymap))
+ (suppress-keymap gnus-carpal-mode-map)
+ (define-key gnus-carpal-mode-map " " 'gnus-carpal-select)
+ (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select)
+ (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select))
+
+(defun gnus-carpal-mode ()
+ "Major mode for clicking buttons.
+
+All normal editing commands are switched off.
+\\<gnus-carpal-mode-map>
+The following commands are available:
+
+\\{gnus-carpal-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq mode-line-modified (cdr gnus-mode-line-modified))
+ (setq major-mode 'gnus-carpal-mode)
+ (setq mode-name "Gnus Carpal")
+ (setq mode-line-process nil)
+ (use-local-map gnus-carpal-mode-map)
+ (buffer-disable-undo (current-buffer))
+ (setq buffer-read-only t)
+ (make-local-variable 'gnus-carpal-attached-buffer)
+ (run-hooks 'gnus-carpal-mode-hook))
+
+(defun gnus-carpal-setup-buffer (type)
+ (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type)))))
+ (if (get-buffer buffer)
+ ()
+ (save-excursion
+ (set-buffer (get-buffer-create buffer))
+ (gnus-carpal-mode)
+ (setq gnus-carpal-attached-buffer
+ (intern (format "gnus-%s-buffer" type)))
+ (gnus-add-current-to-buffer-list)
+ (let ((buttons (symbol-value
+ (intern (format "gnus-carpal-%s-buffer-buttons"
+ type))))
+ (buffer-read-only nil)
+ button)
+ (while buttons
+ (setq button (car buttons)
+ buttons (cdr buttons))
+ (if (stringp button)
+ (gnus-set-text-properties
+ (point)
+ (prog2 (insert button) (point) (insert " "))
+ (list 'face gnus-carpal-header-face))
+ (gnus-set-text-properties
+ (point)
+ (prog2 (insert (car button)) (point) (insert " "))
+ (list 'gnus-callback (cdr button)
+ 'face gnus-carpal-button-face
+ gnus-mouse-face-prop 'highlight))))
+ (let ((fill-column (- (window-width) 2)))
+ (fill-region (point-min) (point-max)))
+ (set-window-point (get-buffer-window (current-buffer))
+ (point-min)))))))
+
+(defun gnus-carpal-select ()
+ "Select the button under point."
+ (interactive)
+ (let ((func (get-text-property (point) 'gnus-callback)))
+ (if (null func)
+ ()
+ (pop-to-buffer (symbol-value gnus-carpal-attached-buffer))
+ (call-interactively func))))
+
+(defun gnus-carpal-mouse-select (event)
+ "Select the button under the mouse pointer."
+ (interactive "e")
+ (mouse-set-point event)
+ (gnus-carpal-select))
+
+;;; Allow redefinition of functions.
+(gnus-ems-redefine)
+
+(provide 'gnus-salt)
+
+;;; gnus-salt.el ends here
--- /dev/null
+1;;; gnus-score.el --- scoring code for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-sum)
+(require 'gnus-range)
+(require 'message)
+
+(defcustom gnus-global-score-files nil
+ "List of global score files and directories.
+Set this variable if you want to use people's score files. One entry
+for each score file or each score file directory. Gnus will decide
+by itself what score files are applicable to which group.
+
+Say you want to use the single score file
+\"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
+score files in the \"/ftp.some-where:/pub/score\" directory.
+
+ (setq gnus-global-score-files
+ '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
+ \"/ftp.some-where:/pub/score\"))"
+ :group 'gnus-score-files
+ :type '(repeat file))
+
+(defcustom gnus-score-file-single-match-alist nil
+ "Alist mapping regexps to lists of score files.
+Each element of this alist should be of the form
+ (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
+
+If the name of a group is matched by REGEXP, the corresponding scorefiles
+will be used for that group.
+The first match found is used, subsequent matching entries are ignored (to
+use multiple matches, see gnus-score-file-multiple-match-alist).
+
+These score files are loaded in addition to any files returned by
+gnus-score-find-score-files-function (which see)."
+ :group 'gnus-score-files
+ :type '(repeat (cons regexp (repeat file))))
+
+(defcustom gnus-score-file-multiple-match-alist nil
+ "Alist mapping regexps to lists of score files.
+Each element of this alist should be of the form
+ (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
+
+If the name of a group is matched by REGEXP, the corresponding scorefiles
+will be used for that group.
+If multiple REGEXPs match a group, the score files corresponding to each
+match will be used (for only one match to be used, see
+gnus-score-file-single-match-alist).
+
+These score files are loaded in addition to any files returned by
+gnus-score-find-score-files-function (which see)."
+ :group 'gnus-score-files
+ :type '(repeat (cons regexp (repeat file))))
+
+(defcustom gnus-score-file-suffix "SCORE"
+ "Suffix of the score files."
+ :group 'gnus-score-files
+ :type 'string)
+
+(defcustom gnus-adaptive-file-suffix "ADAPT"
+ "Suffix of the adaptive score files."
+ :group 'gnus-score-files
+ :group 'gnus-score-adapt
+ :type 'string)
+
+(defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
+ "Function used to find score files.
+The function will be called with the group name as the argument, and
+should return a list of score files to apply to that group. The score
+files do not actually have to exist.
+
+Predefined values are:
+
+gnus-score-find-single: Only apply the group's own score file.
+gnus-score-find-hierarchical: Also apply score files from parent groups.
+gnus-score-find-bnews: Apply score files whose names matches.
+
+See the documentation to these functions for more information.
+
+This variable can also be a list of functions to be called. Each
+function should either return a list of score files, or a list of
+score alists."
+ :group 'gnus-score-files
+ :type '(radio (function-item gnus-score-find-single)
+ (function-item gnus-score-find-hierarchical)
+ (function-item gnus-score-find-bnews)
+ (function :tag "Other")))
+
+(defcustom gnus-score-interactive-default-score 1000
+ "*Scoring commands will raise/lower the score with this number as the default."
+ :group 'gnus-score-default
+ :type 'integer)
+
+(defcustom gnus-score-expiry-days 7
+ "*Number of days before unused score file entries are expired.
+If this variable is nil, no score file entries will be expired."
+ :group 'gnus-score-expire
+ :type '(choice (const :tag "never" nil)
+ number))
+
+(defcustom gnus-update-score-entry-dates t
+ "*In non-nil, update matching score entry dates.
+If this variable is nil, then score entries that provide matches
+will be expired along with non-matching score entries."
+ :group 'gnus-score-expire
+ :type 'boolean)
+
+(defcustom gnus-orphan-score nil
+ "*All orphans get this score added. Set in the score file."
+ :group 'gnus-score-default
+ :type '(choice (const nil)
+ integer))
+
+(defcustom gnus-decay-scores nil
+ "*If non-nil, decay non-permanent scores."
+ :group 'gnus-score-decay
+ :type 'boolean)
+
+(defcustom gnus-decay-score-function 'gnus-decay-score
+ "*Function called to decay a score.
+It is called with one parameter -- the score to be decayed."
+ :group 'gnus-score-decay
+ :type '(radio (function-item gnus-decay-score)
+ (function :tag "Other")))
+
+(defcustom gnus-score-decay-constant 3
+ "*Decay all \"small\" scores with this amount."
+ :group 'gnus-score-decay
+ :type 'integer)
+
+(defcustom gnus-score-decay-scale .05
+ "*Decay all \"big\" scores with this factor."
+ :group 'gnus-score-decay
+ :type 'number)
+
+(defcustom gnus-home-score-file nil
+ "Variable to control where interactive score entries are to go.
+It can be:
+
+ * A string
+ This file file will be used as the home score file.
+
+ * A function
+ The result of this function will be used as the home score file.
+ The function will be passed the name of the group as its
+ parameter.
+
+ * A list
+ The elements in this list can be:
+
+ * `(regexp file-name ...)'
+ If the `regexp' matches the group name, the first `file-name' will
+ will be used as the home score file. (Multiple filenames are
+ allowed so that one may use gnus-score-file-single-match-alist to
+ set this variable.)
+
+ * A function.
+ If the function returns non-nil, the result will be used
+ as the home score file. The function will be passed the
+ name of the group as its parameter.
+
+ * A string. Use the string as the home score file.
+
+ The list will be traversed from the beginning towards the end looking
+ for matches."
+ :group 'gnus-score-files
+ :type '(choice string
+ (repeat (choice string
+ (cons regexp (repeat file))
+ function))
+ function))
+
+(defcustom gnus-home-adapt-file nil
+ "Variable to control where new adaptive score entries are to go.
+This variable allows the same syntax as `gnus-home-score-file'."
+ :group 'gnus-score-adapt
+ :group 'gnus-score-files
+ :type '(choice string
+ (repeat (choice string
+ (cons regexp (repeat file))
+ function))
+ function))
+
+(defcustom gnus-default-adaptive-score-alist
+ '((gnus-kill-file-mark)
+ (gnus-unread-mark)
+ (gnus-read-mark (from 3) (subject 30))
+ (gnus-catchup-mark (subject -10))
+ (gnus-killed-mark (from -1) (subject -20))
+ (gnus-del-mark (from -2) (subject -15)))
+"Alist of marks and scores."
+:group 'gnus-score-adapt
+:type '(repeat (cons (symbol :tag "Mark")
+ (repeat (list (choice :tag "Header"
+ (const from)
+ (const subject)
+ (symbol :tag "other"))
+ (integer :tag "Score"))))))
+
+(defcustom gnus-ignored-adaptive-words nil
+ "List of words to be ignored when doing adaptive word scoring."
+ :group 'gnus-score-adapt
+ :type '(repeat string))
+
+(defcustom gnus-default-ignored-adaptive-words
+ '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you"
+ "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can"
+ "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one"
+ "so" "we" "they" "what" "would" "any" "which" "about" "get" "your"
+ "use" "some" "me" "then" "name" "like" "out" "when" "up" "time"
+ "other" "more" "only" "just" "end" "also" "know" "how" "new" "should"
+ "been" "than" "them" "he" "who" "make" "may" "people" "these" "now"
+ "their" "here" "into" "first" "could" "way" "had" "see" "work" "well"
+ "were" "two" "very" "where" "while" "us" "because" "good" "same"
+ "even" "much" "most" "many" "such" "long" "his" "over" "last" "since"
+ "right" "before" "our" "without" "too" "those" "why" "must" "part"
+ "being" "current" "back" "still" "go" "point" "value" "each" "did"
+ "both" "true" "off" "say" "another" "state" "might" "under" "start"
+ "try" "re")
+ "Default list of words to be ignored when doing adaptive word scoring."
+ :group 'gnus-score-adapt
+ :type '(repeat string))
+
+(defcustom gnus-default-adaptive-word-score-alist
+ `((,gnus-read-mark . 30)
+ (,gnus-catchup-mark . -10)
+ (,gnus-killed-mark . -20)
+ (,gnus-del-mark . -15))
+"Alist of marks and scores."
+:group 'gnus-score-adapt
+:type '(repeat (cons (character :tag "Mark")
+ (integer :tag "Score"))))
+
+(defcustom gnus-score-mimic-keymap nil
+ "*Have the score entry functions pretend that they are a keymap."
+ :group 'gnus-score-default
+ :type 'boolean)
+
+(defcustom gnus-score-exact-adapt-limit 10
+ "*Number that says how long a match has to be before using substring matching.
+When doing adaptive scoring, one normally uses fuzzy or substring
+matching. However, if the header one matches is short, the possibility
+for false positives is great, so if the length of the match is less
+than this variable, exact matching will be used.
+
+If this variable is nil, exact matching will always be used."
+ :group 'gnus-score-adapt
+ :type '(choice (const nil) integer))
+
+(defcustom gnus-score-uncacheable-files "ADAPT$"
+ "All score files that match this regexp will not be cached."
+ :group 'gnus-score-adapt
+ :group 'gnus-score-files
+ :type 'regexp)
+
+(defcustom gnus-score-default-header nil
+ "Default header when entering new scores.
+
+Should be one of the following symbols.
+
+ a: from
+ s: subject
+ b: body
+ h: head
+ i: message-id
+ t: references
+ x: xref
+ l: lines
+ d: date
+ f: followup
+
+If nil, the user will be asked for a header."
+ :group 'gnus-score-default
+ :type '(choice (const :tag "from" a)
+ (const :tag "subject" s)
+ (const :tag "body" b)
+ (const :tag "head" h)
+ (const :tag "message-id" i)
+ (const :tag "references" t)
+ (const :tag "xref" x)
+ (const :tag "lines" l)
+ (const :tag "date" d)
+ (const :tag "followup" f)
+ (const :tag "ask" nil)))
+
+(defcustom gnus-score-default-type nil
+ "Default match type when entering new scores.
+
+Should be one of the following symbols.
+
+ s: substring
+ e: exact string
+ f: fuzzy string
+ r: regexp string
+ b: before date
+ a: at date
+ n: this date
+ <: less than number
+ >: greater than number
+ =: equal to number
+
+If nil, the user will be asked for a match type."
+ :group 'gnus-score-default
+ :type '(choice (const :tag "substring" s)
+ (const :tag "exact string" e)
+ (const :tag "fuzzy string" f)
+ (const :tag "regexp string" r)
+ (const :tag "before date" b)
+ (const :tag "at date" a)
+ (const :tag "this date" n)
+ (const :tag "less than number" <)
+ (const :tag "greater than number" >)
+ (const :tag "equal than number" =)
+ (const :tag "ask" nil)))
+
+(defcustom gnus-score-default-fold nil
+ "Use case folding for new score file entries iff not nil."
+ :group 'gnus-score-default
+ :type 'boolean)
+
+(defcustom gnus-score-default-duration nil
+ "Default duration of effect when entering new scores.
+
+Should be one of the following symbols.
+
+ t: temporary
+ p: permanent
+ i: immediate
+
+If nil, the user will be asked for a duration."
+ :group 'gnus-score-default
+ :type '(choice (const :tag "temporary" t)
+ (const :tag "permanent" p)
+ (const :tag "immediate" i)
+ (const :tag "ask" nil)))
+
+(defcustom gnus-score-after-write-file-function nil
+ "Function called with the name of the score file just written to disk."
+ :group 'gnus-score-files
+ :type 'function)
+
+\f
+
+;; Internal variables.
+
+(defvar gnus-adaptive-word-syntax-table
+ (let ((table (copy-syntax-table (standard-syntax-table)))
+ (numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
+ (while numbers
+ (modify-syntax-entry (pop numbers) " " table))
+ (modify-syntax-entry ?' "w" table)
+ table)
+ "Syntax table used when doing adaptive word scoring.")
+
+(defvar gnus-scores-exclude-files nil)
+(defvar gnus-internal-global-score-files nil)
+(defvar gnus-score-file-list nil)
+
+(defvar gnus-short-name-score-file-cache nil)
+
+(defvar gnus-score-help-winconf nil)
+(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
+(defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist)
+(defvar gnus-score-trace nil)
+(defvar gnus-score-edit-buffer nil)
+
+(defvar gnus-score-alist nil
+ "Alist containing score information.
+The keys can be symbols or strings. The following symbols are defined.
+
+touched: If this alist has been modified.
+mark: Automatically mark articles below this.
+expunge: Automatically expunge articles below this.
+files: List of other score files to load when loading this one.
+eval: Sexp to be evaluated when the score file is loaded.
+
+String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
+where HEADER is the header being scored, MATCH is the string we are
+looking for, TYPE is a flag indicating whether it should use regexp or
+substring matching, SCORE is the score to add and DATE is the date
+of the last successful match.")
+
+(defvar gnus-score-cache nil)
+(defvar gnus-scores-articles nil)
+(defvar gnus-score-index nil)
+
+
+(defconst gnus-header-index
+ ;; Name to index alist.
+ '(("number" 0 gnus-score-integer)
+ ("subject" 1 gnus-score-string)
+ ("from" 2 gnus-score-string)
+ ("date" 3 gnus-score-date)
+ ("message-id" 4 gnus-score-string)
+ ("references" 5 gnus-score-string)
+ ("chars" 6 gnus-score-integer)
+ ("lines" 7 gnus-score-integer)
+ ("xref" 8 gnus-score-string)
+ ("head" -1 gnus-score-body)
+ ("body" -1 gnus-score-body)
+ ("all" -1 gnus-score-body)
+ ("followup" 2 gnus-score-followup)
+ ("thread" 5 gnus-score-thread)))
+
+;;; Summary mode score maps.
+
+(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map)
+ "s" gnus-summary-set-score
+ "a" gnus-summary-score-entry
+ "S" gnus-summary-current-score
+ "c" gnus-score-change-score-file
+ "C" gnus-score-customize
+ "m" gnus-score-set-mark-below
+ "x" gnus-score-set-expunge-below
+ "R" gnus-summary-rescore
+ "e" gnus-score-edit-current-scores
+ "f" gnus-score-edit-file
+ "F" gnus-score-flush-cache
+ "t" gnus-score-find-trace
+ "w" gnus-score-find-favourite-words)
+
+;; Summary score file commands
+
+;; Much modification of the kill (ahem, score) code and lots of the
+;; functions are written by Per Abrahamsen <amanda@iesd.auc.dk>.
+
+(defun gnus-summary-lower-score (&optional score symp)
+ "Make a score entry based on the current article.
+The user will be prompted for header to score on, match type,
+permanence, and the string to be used. The numerical prefix will be
+used as score."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-summary-increase-score (- (gnus-score-default score)) symp))
+
+(defun gnus-score-kill-help-buffer ()
+ (when (get-buffer "*Score Help*")
+ (kill-buffer "*Score Help*")
+ (when gnus-score-help-winconf
+ (set-window-configuration gnus-score-help-winconf))))
+
+(defun gnus-summary-increase-score (&optional score symp)
+ "Make a score entry based on the current article.
+The user will be prompted for header to score on, match type,
+permanence, and the string to be used. The numerical prefix will be
+used as score."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-set-global-variables)
+ (let* ((nscore (gnus-score-default score))
+ (prefix (if (< nscore 0) ?L ?I))
+ (increase (> nscore 0))
+ (char-to-header
+ '((?a "from" nil nil string)
+ (?s "subject" nil nil string)
+ (?b "body" "" nil body-string)
+ (?h "head" "" nil body-string)
+ (?i "message-id" nil t string)
+ (?t "references" "message-id" nil string)
+ (?x "xref" nil nil string)
+ (?l "lines" nil nil number)
+ (?d "date" nil nil date)
+ (?f "followup" nil nil string)
+ (?T "thread" nil nil string)))
+ (char-to-type
+ '((?s s "substring" string)
+ (?e e "exact string" string)
+ (?f f "fuzzy string" string)
+ (?r r "regexp string" string)
+ (?z s "substring" body-string)
+ (?p r "regexp string" body-string)
+ (?b before "before date" date)
+ (?a at "at date" date)
+ (?n now "this date" date)
+ (?< < "less than number" number)
+ (?> > "greater than number" number)
+ (?= = "equal to number" number)))
+ (current-score-file gnus-current-score-file)
+ (char-to-perm
+ (list (list ?t (current-time-string) "temporary")
+ '(?p perm "permanent") '(?i now "immediate")))
+ (mimic gnus-score-mimic-keymap)
+ (hchar (and gnus-score-default-header
+ (aref (symbol-name gnus-score-default-header) 0)))
+ (tchar (and gnus-score-default-type
+ (aref (symbol-name gnus-score-default-type) 0)))
+ (pchar (and gnus-score-default-duration
+ (aref (symbol-name gnus-score-default-duration) 0)))
+ entry temporary type match)
+
+ (unwind-protect
+ (progn
+
+ ;; First we read the header to score.
+ (while (not hchar)
+ (if mimic
+ (progn
+ (sit-for 1)
+ (message "%c-" prefix))
+ (message "%s header (%s?): " (if increase "Increase" "Lower")
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ char-to-header "")))
+ (setq hchar (read-char))
+ (when (or (= hchar ??) (= hchar ?\C-h))
+ (setq hchar nil)
+ (gnus-score-insert-help "Match on header" char-to-header 1)))
+
+ (gnus-score-kill-help-buffer)
+ (unless (setq entry (assq (downcase hchar) char-to-header))
+ (if mimic (error "%c %c" prefix hchar)
+ (error "Illegal header type")))
+
+ (when (/= (downcase hchar) hchar)
+ ;; This was a majuscule, so we end reading and set the defaults.
+ (if mimic (message "%c %c" prefix hchar) (message ""))
+ (setq tchar (or tchar ?s)
+ pchar (or pchar ?t)))
+
+ (let ((legal-types
+ (delq nil
+ (mapcar (lambda (s)
+ (if (eq (nth 4 entry)
+ (nth 3 s))
+ s nil))
+ char-to-type))))
+ ;; We continue reading - the type.
+ (while (not tchar)
+ (if mimic
+ (progn
+ (sit-for 1) (message "%c %c-" prefix hchar))
+ (message "%s header '%s' with match type (%s?): "
+ (if increase "Increase" "Lower")
+ (nth 1 entry)
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ legal-types "")))
+ (setq tchar (read-char))
+ (when (or (= tchar ??) (= tchar ?\C-h))
+ (setq tchar nil)
+ (gnus-score-insert-help "Match type" legal-types 2)))
+
+ (gnus-score-kill-help-buffer)
+ (unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
+ (if mimic (error "%c %c" prefix hchar)
+ (error "Illegal match type"))))
+
+ (when (/= (downcase tchar) tchar)
+ ;; It was a majuscule, so we end reading and use the default.
+ (if mimic (message "%c %c %c" prefix hchar tchar)
+ (message ""))
+ (setq pchar (or pchar ?p)))
+
+ ;; We continue reading.
+ (while (not pchar)
+ (if mimic
+ (progn
+ (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
+ (message "%s permanence (%s?): " (if increase "Increase" "Lower")
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ char-to-perm "")))
+ (setq pchar (read-char))
+ (when (or (= pchar ??) (= pchar ?\C-h))
+ (setq pchar nil)
+ (gnus-score-insert-help "Match permanence" char-to-perm 2)))
+
+ (gnus-score-kill-help-buffer)
+ (if mimic (message "%c %c %c" prefix hchar tchar pchar)
+ (message ""))
+ (unless (setq temporary (cadr (assq pchar char-to-perm)))
+ ;; Deal with der(r)ided superannuated paradigms.
+ (when (and (eq (1+ prefix) 77)
+ (eq (+ hchar 12) 109)
+ (eq tchar 114)
+ (eq (- pchar 4) 111))
+ (error "You rang?"))
+ (if mimic
+ (error "%c %c %c %c" prefix hchar tchar pchar)
+ (error "Illegal match duration"))))
+ ;; Always kill the score help buffer.
+ (gnus-score-kill-help-buffer))
+
+ ;; We have all the data, so we enter this score.
+ (setq match (if (string= (nth 2 entry) "") ""
+ (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))))
+
+ ;; Modify the match, perhaps.
+ (cond
+ ((equal (nth 1 entry) "xref")
+ (when (string-match "^Xref: *" match)
+ (setq match (substring match (match-end 0))))
+ (when (string-match "^[^:]* +" match)
+ (setq match (substring match (match-end 0))))))
+
+ (when (memq type '(r R regexp Regexp))
+ (setq match (regexp-quote match)))
+
+ ;; Change score file to the "all.SCORE" file.
+ (when (eq symp 'a)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-score-load-file
+ (gnus-score-file-name "all"))))
+
+ (gnus-summary-score-entry
+ (nth 1 entry) ; Header
+ match ; Match
+ type ; Type
+ (if (eq score 's) nil score) ; Score
+ (if (eq temporary 'perm) ; Temp
+ nil
+ temporary)
+ (not (nth 3 entry))) ; Prompt
+
+ (when (eq symp 'a)
+ ;; We change the score file back to the previous one.
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-score-load-file current-score-file)))))
+
+(defun gnus-score-insert-help (string alist idx)
+ (setq gnus-score-help-winconf (current-window-configuration))
+ (save-excursion
+ (set-buffer (get-buffer-create "*Score Help*"))
+ (buffer-disable-undo (current-buffer))
+ (delete-windows-on (current-buffer))
+ (erase-buffer)
+ (insert string ":\n\n")
+ (let ((max -1)
+ (list alist)
+ (i 0)
+ n width pad format)
+ ;; find the longest string to display
+ (while list
+ (setq n (length (nth idx (car list))))
+ (unless (> max n)
+ (setq max n))
+ (setq list (cdr list)))
+ (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
+ (setq n (/ (1- (window-width)) max)) ; items per line
+ (setq width (/ (1- (window-width)) n)) ; width of each item
+ ;; insert `n' items, each in a field of width `width'
+ (while alist
+ (if (< i n)
+ ()
+ (setq i 0)
+ (delete-char -1) ; the `\n' takes a char
+ (insert "\n"))
+ (setq pad (- width 3))
+ (setq format (concat "%c: %-" (int-to-string pad) "s"))
+ (insert (format format (caar alist) (nth idx (car alist))))
+ (setq alist (cdr alist))
+ (setq i (1+ i))))
+ ;; display ourselves in a small window at the bottom
+ (gnus-appt-select-lowest-window)
+ (split-window)
+ (pop-to-buffer "*Score Help*")
+ (let ((window-min-height 1))
+ (shrink-window-if-larger-than-buffer))
+ (select-window (get-buffer-window gnus-summary-buffer))))
+
+(defun gnus-summary-header (header &optional no-err)
+ ;; Return HEADER for current articles, or error.
+ (let ((article (gnus-summary-article-number))
+ headers)
+ (if article
+ (if (and (setq headers (gnus-summary-article-header article))
+ (vectorp headers))
+ (aref headers (nth 1 (assoc header gnus-header-index)))
+ (if no-err
+ nil
+ (error "Pseudo-articles can't be scored")))
+ (if no-err
+ (error "No article on current line")
+ nil))))
+
+(defun gnus-newsgroup-score-alist ()
+ (or
+ (let ((param-file (gnus-group-find-parameter
+ gnus-newsgroup-name 'score-file)))
+ (when param-file
+ (gnus-score-load param-file)))
+ (gnus-score-load
+ (gnus-score-file-name gnus-newsgroup-name)))
+ gnus-score-alist)
+
+(defsubst gnus-score-get (symbol &optional alist)
+ ;; Get SYMBOL's definition in ALIST.
+ (cdr (assoc symbol
+ (or alist
+ gnus-score-alist
+ (gnus-newsgroup-score-alist)))))
+
+(defun gnus-summary-score-entry (header match type score date
+ &optional prompt silent)
+ "Enter score file entry.
+HEADER is the header being scored.
+MATCH is the string we are looking for.
+TYPE is the match type: substring, regexp, exact, fuzzy.
+SCORE is the score to add.
+DATE is the expire date, or nil for no expire, or 'now for immediate expire.
+If optional argument `PROMPT' is non-nil, allow user to edit match.
+If optional argument `SILENT' is nil, show effect of score entry."
+ (interactive
+ (list (completing-read "Header: "
+ gnus-header-index
+ (lambda (x) (fboundp (nth 2 x)))
+ t)
+ (read-string "Match: ")
+ (if (y-or-n-p "Use regexp match? ") 'r 's)
+ (and current-prefix-arg
+ (prefix-numeric-value current-prefix-arg))
+ (cond ((not (y-or-n-p "Add to score file? "))
+ 'now)
+ ((y-or-n-p "Expire kill? ")
+ (current-time-string))
+ (t nil))))
+ ;; Regexp is the default type.
+ (when (eq type t)
+ (setq type 'r))
+ ;; Simplify matches...
+ (cond ((or (eq type 'r) (eq type 's) (eq type nil))
+ (setq match (if match (gnus-simplify-subject-re match) "")))
+ ((eq type 'f)
+ (setq match (gnus-simplify-subject-fuzzy match))))
+ (let ((score (gnus-score-default score))
+ (header (format "%s" (downcase header)))
+ new)
+ (when prompt
+ (setq match (read-string
+ (format "Match %s on %s, %s: "
+ (cond ((eq date 'now)
+ "now")
+ ((stringp date)
+ "temp")
+ (t "permanent"))
+ header
+ (if (< score 0) "lower" "raise"))
+ (if (numberp match)
+ (int-to-string match)
+ match))))
+
+ ;; Get rid of string props.
+ (setq match (format "%s" match))
+
+ ;; If this is an integer comparison, we transform from string to int.
+ (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
+ (setq match (string-to-int match)))
+
+ (unless (eq date 'now)
+ ;; Add the score entry to the score file.
+ (when (= score gnus-score-interactive-default-score)
+ (setq score nil))
+ (let ((old (gnus-score-get header))
+ elem)
+ (setq new
+ (cond
+ (type
+ (list match score
+ (and date (if (numberp date) date
+ (gnus-day-number date)))
+ type))
+ (date (list match score (gnus-day-number date)))
+ (score (list match score))
+ (t (list match))))
+ ;; We see whether we can collapse some score entries.
+ ;; This isn't quite correct, because there may be more elements
+ ;; later on with the same key that have matching elems... Hm.
+ (if (and old
+ (setq elem (assoc match old))
+ (eq (nth 3 elem) (nth 3 new))
+ (or (and (numberp (nth 2 elem)) (numberp (nth 2 new)))
+ (and (not (nth 2 elem)) (not (nth 2 new)))))
+ ;; Yup, we just add this new score to the old elem.
+ (setcar (cdr elem) (+ (or (nth 1 elem)
+ gnus-score-interactive-default-score)
+ (or (nth 1 new)
+ gnus-score-interactive-default-score)))
+ ;; Nope, we have to add a new elem.
+ (gnus-score-set header (if old (cons new old) (list new))))
+ (gnus-score-set 'touched '(t))))
+
+ ;; Score the current buffer.
+ (unless silent
+ (if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
+ (eq (nth 2 (assoc header gnus-header-index))
+ 'gnus-score-string))
+ (gnus-summary-score-effect header match type score)
+ (gnus-summary-rescore)))
+
+ ;; Return the new scoring rule.
+ new))
+
+(defun gnus-summary-score-effect (header match type score)
+ "Simulate the effect of a score file entry.
+HEADER is the header being scored.
+MATCH is the string we are looking for.
+TYPE is the score type.
+SCORE is the score to add."
+ (interactive (list (completing-read "Header: "
+ gnus-header-index
+ (lambda (x) (fboundp (nth 2 x)))
+ t)
+ (read-string "Match: ")
+ (y-or-n-p "Use regexp match? ")
+ (prefix-numeric-value current-prefix-arg)))
+ (save-excursion
+ (unless (and (stringp match) (> (length match) 0))
+ (error "No match"))
+ (goto-char (point-min))
+ (let ((regexp (cond ((eq type 'f)
+ (gnus-simplify-subject-fuzzy match))
+ ((eq type 'r)
+ match)
+ ((eq type 'e)
+ (concat "\\`" (regexp-quote match) "\\'"))
+ (t
+ (regexp-quote match)))))
+ (while (not (eobp))
+ (let ((content (gnus-summary-header header 'noerr))
+ (case-fold-search t))
+ (and content
+ (when (if (eq type 'f)
+ (string-equal (gnus-simplify-subject-fuzzy content)
+ regexp)
+ (string-match regexp content))
+ (gnus-summary-raise-score score))))
+ (beginning-of-line 2))))
+ (gnus-set-mode-line 'summary))
+
+(defun gnus-summary-score-crossposting (score date)
+ ;; Enter score file entry for current crossposting.
+ ;; SCORE is the score to add.
+ ;; DATE is the expire date.
+ (let ((xref (gnus-summary-header "xref"))
+ (start 0)
+ group)
+ (unless xref
+ (error "This article is not crossposted"))
+ (while (string-match " \\([^ \t]+\\):" xref start)
+ (setq start (match-end 0))
+ (when (not (string=
+ (setq group
+ (substring xref (match-beginning 1) (match-end 1)))
+ gnus-newsgroup-name))
+ (gnus-summary-score-entry
+ "xref" (concat " " group ":") nil score date t)))))
+
+\f
+;;;
+;;; Gnus Score Files
+;;;
+
+;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
+
+;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
+(defun gnus-score-set-mark-below (score)
+ "Automatically mark articles with score below SCORE as read."
+ (interactive
+ (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
+ (string-to-int (read-string "Mark below: ")))))
+ (setq score (or score gnus-summary-default-score 0))
+ (gnus-score-set 'mark (list score))
+ (gnus-score-set 'touched '(t))
+ (setq gnus-summary-mark-below score)
+ (gnus-score-update-lines))
+
+(defun gnus-score-update-lines ()
+ "Update all lines in the summary buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (gnus-summary-update-line)
+ (forward-line 1))))
+
+(defun gnus-score-update-all-lines ()
+ "Update all lines in the summary buffer, even the hidden ones."
+ (save-excursion
+ (goto-char (point-min))
+ (let (hidden)
+ (while (not (eobp))
+ (when (gnus-summary-show-thread)
+ (push (point) hidden))
+ (gnus-summary-update-line)
+ (forward-line 1))
+ ;; Re-hide the hidden threads.
+ (while hidden
+ (goto-char (pop hidden))
+ (gnus-summary-hide-thread)))))
+
+(defun gnus-score-set-expunge-below (score)
+ "Automatically expunge articles with score below SCORE."
+ (interactive
+ (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
+ (string-to-int (read-string "Set expunge below: ")))))
+ (setq score (or score gnus-summary-default-score 0))
+ (gnus-score-set 'expunge (list score))
+ (gnus-score-set 'touched '(t)))
+
+(defun gnus-score-followup-article (&optional score)
+ "Add SCORE to all followups to the article in the current buffer."
+ (interactive "P")
+ (setq score (gnus-score-default score))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((id (mail-fetch-field "message-id")))
+ (when id
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-score-entry
+ "references" (concat id "[ \t]*$") 'r
+ score (current-time-string) nil t)))))))
+
+(defun gnus-score-followup-thread (&optional score)
+ "Add SCORE to all later articles in the thread the current buffer is part of."
+ (interactive "P")
+ (setq score (gnus-score-default score))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (let ((id (mail-fetch-field "message-id")))
+ (when id
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-score-entry
+ "references" id 's
+ score (current-time-string))))))))
+
+(defun gnus-score-set (symbol value &optional alist)
+ ;; Set SYMBOL to VALUE in ALIST.
+ (let* ((alist
+ (or alist
+ gnus-score-alist
+ (gnus-newsgroup-score-alist)))
+ (entry (assoc symbol alist)))
+ (cond ((gnus-score-get 'read-only alist)
+ ;; This is a read-only score file, so we do nothing.
+ )
+ (entry
+ (setcdr entry value))
+ ((null alist)
+ (error "Empty alist"))
+ (t
+ (setcdr alist
+ (cons (cons symbol value) (cdr alist)))))))
+
+(defun gnus-summary-raise-score (n)
+ "Raise the score of the current article by N."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-summary-set-score (+ (gnus-summary-article-score)
+ (or n gnus-score-interactive-default-score ))))
+
+(defun gnus-summary-set-score (n)
+ "Set the score of the current article to N."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (save-excursion
+ (gnus-summary-show-thread)
+ (let ((buffer-read-only nil))
+ ;; Set score.
+ (gnus-summary-update-mark
+ (if (= n (or gnus-summary-default-score 0)) ?
+ (if (< n (or gnus-summary-default-score 0))
+ gnus-score-below-mark gnus-score-over-mark))
+ 'score))
+ (let* ((article (gnus-summary-article-number))
+ (score (assq article gnus-newsgroup-scored)))
+ (if score (setcdr score n)
+ (push (cons article n) gnus-newsgroup-scored)))
+ (gnus-summary-update-line)))
+
+(defun gnus-summary-current-score ()
+ "Return the score of the current article."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-message 1 "%s" (gnus-summary-article-score)))
+
+(defun gnus-score-change-score-file (file)
+ "Change current score alist."
+ (interactive
+ (list (read-file-name "Change to score file: " gnus-kill-files-directory)))
+ (gnus-score-load-file file)
+ (gnus-set-mode-line 'summary))
+
+(defvar gnus-score-edit-exit-function)
+(defun gnus-score-edit-current-scores (file)
+ "Edit the current score alist."
+ (interactive (list gnus-current-score-file))
+ (gnus-set-global-variables)
+ (let ((winconf (current-window-configuration)))
+ (when (buffer-name gnus-summary-buffer)
+ (gnus-score-save))
+ (gnus-make-directory (file-name-directory file))
+ (setq gnus-score-edit-buffer (find-file-noselect file))
+ (gnus-configure-windows 'edit-score)
+ (select-window (get-buffer-window gnus-score-edit-buffer))
+ (gnus-score-mode)
+ (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq gnus-prev-winconf winconf))
+ (gnus-message
+ 4 (substitute-command-keys
+ "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+
+(defun gnus-score-edit-file (file)
+ "Edit a score file."
+ (interactive
+ (list (read-file-name "Edit score file: " gnus-kill-files-directory)))
+ (gnus-make-directory (file-name-directory file))
+ (when (buffer-name gnus-summary-buffer)
+ (gnus-score-save))
+ (let ((winconf (current-window-configuration)))
+ (setq gnus-score-edit-buffer (find-file-noselect file))
+ (gnus-configure-windows 'edit-score)
+ (gnus-score-mode)
+ (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq gnus-prev-winconf winconf))
+ (gnus-message
+ 4 (substitute-command-keys
+ "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+
+(defun gnus-score-load-file (file)
+ ;; Load score file FILE. Returns a list a retrieved score-alists.
+ (let* ((file (expand-file-name
+ (or (and (string-match
+ (concat "^" (expand-file-name
+ gnus-kill-files-directory))
+ (expand-file-name file))
+ file)
+ (concat (file-name-as-directory gnus-kill-files-directory)
+ file))))
+ (cached (assoc file gnus-score-cache))
+ (global (member file gnus-internal-global-score-files))
+ lists alist)
+ (if cached
+ ;; The score file was already loaded.
+ (setq alist (cdr cached))
+ ;; We load the score file.
+ (setq gnus-score-alist nil)
+ (setq alist (gnus-score-load-score-alist file))
+ ;; We add '(touched) to the alist to signify that it hasn't been
+ ;; touched (yet).
+ (unless (assq 'touched alist)
+ (push (list 'touched nil) alist))
+ ;; If it is a global score file, we make it read-only.
+ (and global
+ (not (assq 'read-only alist))
+ (push (list 'read-only t) alist))
+ (push (cons file alist) gnus-score-cache))
+ (let ((a alist)
+ found)
+ (while a
+ ;; Downcase all header names.
+ (when (stringp (caar a))
+ (setcar (car a) (downcase (caar a)))
+ (setq found t))
+ (pop a))
+ ;; If there are actual scores in the alist, we add it to the
+ ;; return value of this function.
+ (when found
+ (setq lists (list alist))))
+ ;; Treat the other possible atoms in the score alist.
+ (let ((mark (car (gnus-score-get 'mark alist)))
+ (expunge (car (gnus-score-get 'expunge alist)))
+ (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
+ (files (gnus-score-get 'files alist))
+ (exclude-files (gnus-score-get 'exclude-files alist))
+ (orphan (car (gnus-score-get 'orphan alist)))
+ (adapt (gnus-score-get 'adapt alist))
+ (thread-mark-and-expunge
+ (car (gnus-score-get 'thread-mark-and-expunge alist)))
+ (adapt-file (car (gnus-score-get 'adapt-file alist)))
+ (local (gnus-score-get 'local alist))
+ (decay (car (gnus-score-get 'decay alist)))
+ (eval (car (gnus-score-get 'eval alist))))
+ ;; Perform possible decays.
+ (when (and gnus-decay-scores
+ (or (not decay)
+ (gnus-decay-scores alist decay)))
+ (gnus-score-set 'touched '(t) alist)
+ (gnus-score-set 'decay (list (gnus-time-to-day (current-time)))))
+ ;; We do not respect eval and files atoms from global score
+ ;; files.
+ (when (and files (not global))
+ (setq lists (apply 'append lists
+ (mapcar (lambda (file)
+ (gnus-score-load-file file))
+ (if adapt-file (cons adapt-file files)
+ files)))))
+ (when (and eval (not global))
+ (eval eval))
+ ;; We then expand any exclude-file directives.
+ (setq gnus-scores-exclude-files
+ (nconc
+ (mapcar
+ (lambda (sfile)
+ (expand-file-name sfile (file-name-directory file)))
+ exclude-files)
+ gnus-scores-exclude-files))
+ (unless local
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (while local
+ (and (consp (car local))
+ (symbolp (caar local))
+ (progn
+ (make-local-variable (caar local))
+ (set (caar local) (nth 1 (car local)))))
+ (setq local (cdr local)))))
+ (when orphan
+ (setq gnus-orphan-score orphan))
+ (setq gnus-adaptive-score-alist
+ (cond ((equal adapt '(t))
+ (setq gnus-newsgroup-adaptive t)
+ gnus-default-adaptive-score-alist)
+ ((equal adapt '(ignore))
+ (setq gnus-newsgroup-adaptive nil))
+ ((consp adapt)
+ (setq gnus-newsgroup-adaptive t)
+ adapt)
+ (t
+ ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring)
+ gnus-default-adaptive-score-alist)))
+ (setq gnus-thread-expunge-below
+ (or thread-mark-and-expunge gnus-thread-expunge-below))
+ (setq gnus-summary-mark-below
+ (or mark mark-and-expunge gnus-summary-mark-below))
+ (setq gnus-summary-expunge-below
+ (or expunge mark-and-expunge gnus-summary-expunge-below))
+ (setq gnus-newsgroup-adaptive-score-file
+ (or adapt-file gnus-newsgroup-adaptive-score-file)))
+ (setq gnus-current-score-file file)
+ (setq gnus-score-alist alist)
+ lists))
+
+(defun gnus-score-load (file)
+ ;; Load score FILE.
+ (let ((cache (assoc file gnus-score-cache)))
+ (if cache
+ (setq gnus-score-alist (cdr cache))
+ (setq gnus-score-alist nil)
+ (gnus-score-load-score-alist file)
+ (unless gnus-score-alist
+ (setq gnus-score-alist (copy-alist '((touched nil)))))
+ (push (cons file gnus-score-alist) gnus-score-cache))))
+
+(defun gnus-score-remove-from-cache (file)
+ (setq gnus-score-cache
+ (delq (assoc file gnus-score-cache) gnus-score-cache)))
+
+(defun gnus-score-load-score-alist (file)
+ "Read score FILE."
+ (let (alist)
+ (if (not (file-readable-p file))
+ ;; Couldn't read file.
+ (setq gnus-score-alist nil)
+ ;; Read file.
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert-file-contents file)
+ (goto-char (point-min))
+ ;; Only do the loading if the score file isn't empty.
+ (when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t))
+ (setq alist
+ (condition-case ()
+ (read (current-buffer))
+ (error
+ (gnus-error 3.2 "Problem with score file %s" file))))))
+ (if (eq (car alist) 'setq)
+ ;; This is an old-style score file.
+ (setq gnus-score-alist (gnus-score-transform-old-to-new alist))
+ (setq gnus-score-alist alist))
+ ;; Check the syntax of the score file.
+ (setq gnus-score-alist
+ (gnus-score-check-syntax gnus-score-alist file)))))
+
+(defun gnus-score-check-syntax (alist file)
+ "Check the syntax of the score ALIST."
+ (cond
+ ((null alist)
+ nil)
+ ((not (consp alist))
+ (gnus-message 1 "Score file is not a list: %s" file)
+ (ding)
+ nil)
+ (t
+ (let ((a alist)
+ sr err s type)
+ (while (and a (not err))
+ (setq
+ err
+ (cond
+ ((not (listp (car a)))
+ (format "Illegal score element %s in %s" (car a) file))
+ ((stringp (caar a))
+ (cond
+ ((not (listp (setq sr (cdar a))))
+ (format "Illegal header match %s in %s" (nth 1 (car a)) file))
+ (t
+ (setq type (caar a))
+ (while (and sr (not err))
+ (setq s (pop sr))
+ (setq
+ err
+ (cond
+ ((if (member (downcase type) '("lines" "chars"))
+ (not (numberp (car s)))
+ (not (stringp (car s))))
+ (format "Illegal match %s in %s" (car s) file))
+ ((and (cadr s) (not (integerp (cadr s))))
+ (format "Non-integer score %s in %s" (cadr s) file))
+ ((and (caddr s) (not (integerp (caddr s))))
+ (format "Non-integer date %s in %s" (caddr s) file))
+ ((and (cadddr s) (not (symbolp (cadddr s))))
+ (format "Non-symbol match type %s in %s" (cadddr s) file)))))
+ err)))))
+ (setq a (cdr a)))
+ (if err
+ (progn
+ (ding)
+ (gnus-message 3 err)
+ (sit-for 2)
+ nil)
+ alist)))))
+
+(defun gnus-score-transform-old-to-new (alist)
+ (let* ((alist (nth 2 alist))
+ out entry)
+ (when (eq (car alist) 'quote)
+ (setq alist (nth 1 alist)))
+ (while alist
+ (setq entry (car alist))
+ (if (stringp (car entry))
+ (let ((scor (cdr entry)))
+ (push entry out)
+ (while scor
+ (setcar scor
+ (list (caar scor) (nth 2 (car scor))
+ (and (nth 3 (car scor))
+ (gnus-day-number (nth 3 (car scor))))
+ (if (nth 1 (car scor)) 'r 's)))
+ (setq scor (cdr scor))))
+ (push (if (not (listp (cdr entry)))
+ (list (car entry) (cdr entry))
+ entry)
+ out))
+ (setq alist (cdr alist)))
+ (cons (list 'touched t) (nreverse out))))
+
+(defun gnus-score-save ()
+ ;; Save all score information.
+ (let ((cache gnus-score-cache)
+ entry score file)
+ (save-excursion
+ (setq gnus-score-alist nil)
+ (nnheader-set-temp-buffer " *Gnus Scores*")
+ (while cache
+ (current-buffer)
+ (setq entry (pop cache)
+ file (car entry)
+ score (cdr entry))
+ (if (or (not (equal (gnus-score-get 'touched score) '(t)))
+ (gnus-score-get 'read-only score)
+ (and (file-exists-p file)
+ (not (file-writable-p file))))
+ ()
+ (setq score (setcdr entry (delq (assq 'touched score) score)))
+ (erase-buffer)
+ (let (emacs-lisp-mode-hook)
+ (if (string-match
+ (concat (regexp-quote gnus-adaptive-file-suffix) "$")
+ file)
+ ;; This is an adaptive score file, so we do not run
+ ;; it through `pp'. These files can get huge, and
+ ;; are not meant to be edited by human hands.
+ (gnus-prin1 score)
+ ;; This is a normal score file, so we print it very
+ ;; prettily.
+ (pp score (current-buffer))))
+ (gnus-make-directory (file-name-directory file))
+ ;; If the score file is empty, we delete it.
+ (if (zerop (buffer-size))
+ (delete-file file)
+ ;; There are scores, so we write the file.
+ (when (file-writable-p file)
+ (gnus-write-buffer file)
+ (when gnus-score-after-write-file-function
+ (funcall gnus-score-after-write-file-function file)))))
+ (and gnus-score-uncacheable-files
+ (string-match gnus-score-uncacheable-files file)
+ (gnus-score-remove-from-cache file)))
+ (kill-buffer (current-buffer)))))
+
+(defun gnus-score-load-files (score-files)
+ "Load all score files in SCORE-FILES."
+ ;; Load the score files.
+ (let (scores)
+ (while score-files
+ (if (stringp (car score-files))
+ ;; It is a string, which means that it's a score file name,
+ ;; so we load the score file and add the score alist to
+ ;; the list of alists.
+ (setq scores (nconc (gnus-score-load-file (car score-files)) scores))
+ ;; It is an alist, so we just add it to the list directly.
+ (setq scores (nconc (car score-files) scores)))
+ (setq score-files (cdr score-files)))
+ ;; Prune the score files that are to be excluded, if any.
+ (when gnus-scores-exclude-files
+ (let ((s scores)
+ c)
+ (while s
+ (and (setq c (rassq (car s) gnus-score-cache))
+ (member (car c) gnus-scores-exclude-files)
+ (setq scores (delq (car s) scores)))
+ (setq s (cdr s)))))
+ scores))
+
+(defun gnus-score-headers (score-files &optional trace)
+ ;; Score `gnus-newsgroup-headers'.
+ (let (scores news)
+ ;; PLM: probably this is not the best place to clear orphan-score
+ (setq gnus-orphan-score nil
+ gnus-scores-articles nil
+ gnus-scores-exclude-files nil
+ scores (gnus-score-load-files score-files))
+ (setq news scores)
+ ;; Do the scoring.
+ (while news
+ (setq scores news
+ news nil)
+ (when (and gnus-summary-default-score
+ scores)
+ (let* ((entries gnus-header-index)
+ (now (gnus-day-number (current-time-string)))
+ (expire (and gnus-score-expiry-days
+ (- now gnus-score-expiry-days)))
+ (headers gnus-newsgroup-headers)
+ (current-score-file gnus-current-score-file)
+ entry header new)
+ (gnus-message 5 "Scoring...")
+ ;; Create articles, an alist of the form `(HEADER . SCORE)'.
+ (while (setq header (pop headers))
+ ;; WARNING: The assq makes the function O(N*S) while it could
+ ;; be written as O(N+S), where N is (length gnus-newsgroup-headers)
+ ;; and S is (length gnus-newsgroup-scored).
+ (unless (assq (mail-header-number header) gnus-newsgroup-scored)
+ (setq gnus-scores-articles ;Total of 2 * N cons-cells used.
+ (cons (cons header (or gnus-summary-default-score 0))
+ gnus-scores-articles))))
+
+ (save-excursion
+ (set-buffer (get-buffer-create "*Headers*"))
+ (buffer-disable-undo (current-buffer))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (message-clone-locals gnus-summary-buffer))
+
+ ;; Set the global variant of this variable.
+ (setq gnus-current-score-file current-score-file)
+ ;; score orphans
+ (when gnus-orphan-score
+ (setq gnus-score-index
+ (nth 1 (assoc "references" gnus-header-index)))
+ (gnus-score-orphans gnus-orphan-score))
+ ;; Run each header through the score process.
+ (while entries
+ (setq entry (pop entries)
+ header (nth 0 entry)
+ gnus-score-index (nth 1 (assoc header gnus-header-index)))
+ (when (< 0 (apply 'max (mapcar
+ (lambda (score)
+ (length (gnus-score-get header score)))
+ scores)))
+ ;; Call the scoring function for this type of "header".
+ (when (setq new (funcall (nth 2 entry) scores header
+ now expire trace))
+ (push new news))))
+ ;; Remove the buffer.
+ (kill-buffer (current-buffer)))
+
+ ;; Add articles to `gnus-newsgroup-scored'.
+ (while gnus-scores-articles
+ (when (or (/= gnus-summary-default-score
+ (cdar gnus-scores-articles))
+ gnus-save-score)
+ (push (cons (mail-header-number (caar gnus-scores-articles))
+ (cdar gnus-scores-articles))
+ gnus-newsgroup-scored))
+ (setq gnus-scores-articles (cdr gnus-scores-articles)))
+
+ (let (score)
+ (while (setq score (pop scores))
+ (while score
+ (when (listp (caar score))
+ (gnus-score-advanced (car score) trace))
+ (pop score))))
+
+ (gnus-message 5 "Scoring...done"))))))
+
+
+(defun gnus-get-new-thread-ids (articles)
+ (let ((index (nth 1 (assoc "message-id" gnus-header-index)))
+ (refind gnus-score-index)
+ id-list art this tref)
+ (while articles
+ (setq art (car articles)
+ this (aref (car art) index)
+ tref (aref (car art) refind)
+ articles (cdr articles))
+ (when (string-equal tref "") ;no references line
+ (push this id-list)))
+ id-list))
+
+;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers).
+(defun gnus-score-orphans (score)
+ (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles))
+ alike articles art arts this last this-id)
+
+ (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
+ articles gnus-scores-articles)
+
+ ;;more or less the same as in gnus-score-string
+ (erase-buffer)
+ (while articles
+ (setq art (car articles)
+ this (aref (car art) gnus-score-index)
+ articles (cdr articles))
+ ;;completely skip if this is empty (not a child, so not an orphan)
+ (when (not (string= this ""))
+ (if (equal last this)
+ ;; O(N*H) cons-cells used here, where H is the number of
+ ;; headers.
+ (push art alike)
+ (when last
+ ;; Insert the line, with a text property on the
+ ;; terminating newline referring to the articles with
+ ;; this line.
+ (insert last ?\n)
+ (put-text-property (1- (point)) (point) 'articles alike))
+ (setq alike (list art)
+ last this))))
+ (when last ; Bwadr, duplicate code.
+ (insert last ?\n)
+ (put-text-property (1- (point)) (point) 'articles alike))
+
+ ;; PLM: now delete those lines that contain an entry from new-thread-ids
+ (while new-thread-ids
+ (setq this-id (car new-thread-ids)
+ new-thread-ids (cdr new-thread-ids))
+ (goto-char (point-min))
+ (while (search-forward this-id nil t)
+ ;; found a match. remove this line
+ (beginning-of-line)
+ (kill-line 1)))
+
+ ;; now for each line: update its articles with score by moving to
+ ;; every end-of-line in the buffer and read the articles property
+ (goto-char (point-min))
+ (while (eq 0 (progn
+ (end-of-line)
+ (setq arts (get-text-property (point) 'articles))
+ (while arts
+ (setq art (car arts)
+ arts (cdr arts))
+ (setcdr art (+ score (cdr art))))
+ (forward-line))))))
+
+
+(defun gnus-score-integer (scores header now expire &optional trace)
+ (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
+ entries alist)
+
+ ;; Find matches.
+ (while scores
+ (setq alist (car scores)
+ scores (cdr scores)
+ entries (assoc header alist))
+ (while (cdr entries) ;First entry is the header index.
+ (let* ((rest (cdr entries))
+ (kill (car rest))
+ (match (nth 0 kill))
+ (type (or (nth 3 kill) '>))
+ (score (or (nth 1 kill) gnus-score-interactive-default-score))
+ (date (nth 2 kill))
+ (found nil)
+ (match-func (if (or (eq type '>) (eq type '<) (eq type '<=)
+ (eq type '>=) (eq type '=))
+ type
+ (error "Illegal match type: %s" type)))
+ (articles gnus-scores-articles))
+ ;; Instead of doing all the clever stuff that
+ ;; `gnus-score-string' does to minimize searches and stuff,
+ ;; I will assume that people generally will put so few
+ ;; matches on numbers that any cleverness will take more
+ ;; time than one would gain.
+ (while articles
+ (when (funcall match-func
+ (or (aref (caar articles) gnus-score-index) 0)
+ match)
+ (when trace
+ (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
+ gnus-score-trace))
+ (setq found t)
+ (setcdr (car articles) (+ score (cdar articles))))
+ (setq articles (cdr articles)))
+ ;; Update expire date
+ (cond ((null date)) ;Permanent entry.
+ ((and found gnus-update-score-entry-dates) ;Match, update date.
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now))
+ ((and expire (< date expire)) ;Old entry, remove.
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cdr rest))
+ (setq rest entries)))
+ (setq entries rest)))))
+ nil)
+
+(defun gnus-score-date (scores header now expire &optional trace)
+ (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
+ entries alist match match-func article)
+
+ ;; Find matches.
+ (while scores
+ (setq alist (car scores)
+ scores (cdr scores)
+ entries (assoc header alist))
+ (while (cdr entries) ;First entry is the header index.
+ (let* ((rest (cdr entries))
+ (kill (car rest))
+ (type (or (nth 3 kill) 'before))
+ (score (or (nth 1 kill) gnus-score-interactive-default-score))
+ (date (nth 2 kill))
+ (found nil)
+ (articles gnus-scores-articles)
+ l)
+ (cond
+ ((eq type 'after)
+ (setq match-func 'string<
+ match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type 'before)
+ (setq match-func 'gnus-string>
+ match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type 'at)
+ (setq match-func 'string=
+ match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type 'regexp)
+ (setq match-func 'string-match
+ match (nth 0 kill)))
+ (t (error "Illegal match type: %s" type)))
+ ;; Instead of doing all the clever stuff that
+ ;; `gnus-score-string' does to minimize searches and stuff,
+ ;; I will assume that people generally will put so few
+ ;; matches on numbers that any cleverness will take more
+ ;; time than one would gain.
+ (while (setq article (pop articles))
+ (when (and
+ (setq l (aref (car article) gnus-score-index))
+ (funcall match-func match (gnus-date-iso8601 l)))
+ (when trace
+ (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
+ gnus-score-trace))
+ (setq found t)
+ (setcdr article (+ score (cdr article)))))
+ ;; Update expire date
+ (cond ((null date)) ;Permanent entry.
+ ((and found gnus-update-score-entry-dates) ;Match, update date.
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now))
+ ((and expire (< date expire)) ;Old entry, remove.
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cdr rest))
+ (setq rest entries)))
+ (setq entries rest)))))
+ nil)
+
+(defun gnus-score-body (scores header now expire &optional trace)
+ (save-excursion
+ (setq gnus-scores-articles
+ (sort gnus-scores-articles
+ (lambda (a1 a2)
+ (< (mail-header-number (car a1))
+ (mail-header-number (car a2))))))
+ (set-buffer nntp-server-buffer)
+ (save-restriction
+ (let* ((buffer-read-only nil)
+ (articles gnus-scores-articles)
+ (all-scores scores)
+ (request-func (cond ((string= "head" header)
+ 'gnus-request-head)
+ ((string= "body" header)
+ 'gnus-request-body)
+ (t 'gnus-request-article)))
+ entries alist ofunc article last)
+ (when articles
+ (setq last (mail-header-number (caar (last articles))))
+ ;; Not all backends support partial fetching. In that case,
+ ;; we just fetch the entire article.
+ (unless (gnus-check-backend-function
+ (and (string-match "^gnus-" (symbol-name request-func))
+ (intern (substring (symbol-name request-func)
+ (match-end 0))))
+ gnus-newsgroup-name)
+ (setq ofunc request-func)
+ (setq request-func 'gnus-request-article))
+ (while articles
+ (setq article (mail-header-number (caar articles)))
+ (gnus-message 7 "Scoring on article %s of %s..." article last)
+ (when (funcall request-func article gnus-newsgroup-name)
+ (widen)
+ (goto-char (point-min))
+ ;; If just parts of the article is to be searched, but the
+ ;; backend didn't support partial fetching, we just narrow
+ ;; to the relevant parts.
+ (when ofunc
+ (if (eq ofunc 'gnus-request-head)
+ (narrow-to-region
+ (point)
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (narrow-to-region
+ (or (search-forward "\n\n" nil t) (point))
+ (point-max))))
+ (setq scores all-scores)
+ ;; Find matches.
+ (while scores
+ (setq alist (pop scores)
+ entries (assoc header alist))
+ (while (cdr entries) ;First entry is the header index.
+ (let* ((rest (cdr entries))
+ (kill (car rest))
+ (match (nth 0 kill))
+ (type (or (nth 3 kill) 's))
+ (score (or (nth 1 kill)
+ gnus-score-interactive-default-score))
+ (date (nth 2 kill))
+ (found nil)
+ (case-fold-search
+ (not (or (eq type 'R) (eq type 'S)
+ (eq type 'Regexp) (eq type 'String))))
+ (search-func
+ (cond ((or (eq type 'r) (eq type 'R)
+ (eq type 'regexp) (eq type 'Regexp))
+ 're-search-forward)
+ ((or (eq type 's) (eq type 'S)
+ (eq type 'string) (eq type 'String))
+ 'search-forward)
+ (t
+ (error "Illegal match type: %s" type)))))
+ (goto-char (point-min))
+ (when (funcall search-func match nil t)
+ ;; Found a match, update scores.
+ (setcdr (car articles) (+ score (cdar articles)))
+ (setq found t)
+ (when trace
+ (push
+ (cons (car-safe (rassq alist gnus-score-cache)) kill)
+ gnus-score-trace)))
+ ;; Update expire date
+ (unless trace
+ (cond
+ ((null date)) ;Permanent entry.
+ ((and found gnus-update-score-entry-dates)
+ ;; Match, update date.
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now))
+ ((and expire (< date expire)) ;Old entry, remove.
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cdr rest))
+ (setq rest entries))))
+ (setq entries rest)))))
+ (setq articles (cdr articles)))))))
+ nil)
+
+(defun gnus-score-thread (scores header now expire &optional trace)
+ (gnus-score-followup scores header now expire trace t))
+
+(defun gnus-score-followup (scores header now expire &optional trace thread)
+ ;; Insert the unique article headers in the buffer.
+ (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
+ (current-score-file gnus-current-score-file)
+ (all-scores scores)
+ ;; gnus-score-index is used as a free variable.
+ alike last this art entries alist articles
+ new news)
+
+ ;; Change score file to the adaptive score file. All entries that
+ ;; this function makes will be put into this file.
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-score-load-file
+ (or gnus-newsgroup-adaptive-score-file
+ (gnus-score-file-name
+ gnus-newsgroup-name gnus-adaptive-file-suffix))))
+
+ (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
+ articles gnus-scores-articles)
+
+ (erase-buffer)
+ (while articles
+ (setq art (car articles)
+ this (aref (car art) gnus-score-index)
+ articles (cdr articles))
+ (if (equal last this)
+ (push art alike)
+ (when last
+ (insert last ?\n)
+ (put-text-property (1- (point)) (point) 'articles alike))
+ (setq alike (list art)
+ last this)))
+ (when last ; Bwadr, duplicate code.
+ (insert last ?\n)
+ (put-text-property (1- (point)) (point) 'articles alike))
+
+ ;; Find matches.
+ (while scores
+ (setq alist (car scores)
+ scores (cdr scores)
+ entries (assoc header alist))
+ (while (cdr entries) ;First entry is the header index.
+ (let* ((rest (cdr entries))
+ (kill (car rest))
+ (match (nth 0 kill))
+ (type (or (nth 3 kill) 's))
+ (score (or (nth 1 kill) gnus-score-interactive-default-score))
+ (date (nth 2 kill))
+ (found nil)
+ (mt (aref (symbol-name type) 0))
+ (case-fold-search
+ (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F))))
+ (dmt (downcase mt))
+ (search-func
+ (cond ((= dmt ?r) 're-search-forward)
+ ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
+ (t (error "Illegal match type: %s" type))))
+ arts art)
+ (goto-char (point-min))
+ (if (= dmt ?e)
+ (while (funcall search-func match nil t)
+ (and (= (progn (beginning-of-line) (point))
+ (match-beginning 0))
+ (= (progn (end-of-line) (point))
+ (match-end 0))
+ (progn
+ (setq found (setq arts (get-text-property
+ (point) 'articles)))
+ ;; Found a match, update scores.
+ (while arts
+ (setq art (car arts)
+ arts (cdr arts))
+ (gnus-score-add-followups
+ (car art) score all-scores thread))))
+ (end-of-line))
+ (while (funcall search-func match nil t)
+ (end-of-line)
+ (setq found (setq arts (get-text-property (point) 'articles)))
+ ;; Found a match, update scores.
+ (while (setq art (pop arts))
+ (when (setq new (gnus-score-add-followups
+ (car art) score all-scores thread))
+ (push new news)))))
+ ;; Update expire date
+ (cond ((null date)) ;Permanent entry.
+ ((and found gnus-update-score-entry-dates) ;Match, update date.
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now))
+ ((and expire (< date expire)) ;Old entry, remove.
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cdr rest))
+ (setq rest entries)))
+ (setq entries rest))))
+ ;; We change the score file back to the previous one.
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-score-load-file current-score-file))
+ (list (cons "references" news))))
+
+(defun gnus-score-add-followups (header score scores &optional thread)
+ "Add a score entry to the adapt file."
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let* ((id (mail-header-id header))
+ (scores (car scores))
+ entry dont)
+ ;; Don't enter a score if there already is one.
+ (while (setq entry (pop scores))
+ (and (equal "references" (car entry))
+ (or (null (nth 3 (cadr entry)))
+ (eq 's (nth 3 (cadr entry))))
+ (assoc id entry)
+ (setq dont t)))
+ (unless dont
+ (gnus-summary-score-entry
+ (if thread "thread" "references")
+ id 's score (current-time-string) nil t)))))
+
+(defun gnus-score-string (score-list header now expire &optional trace)
+ ;; Score ARTICLES according to HEADER in SCORE-LIST.
+ ;; Update matching entries to NOW and remove unmatched entries older
+ ;; than EXPIRE.
+
+ ;; Insert the unique article headers in the buffer.
+ (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
+ ;; gnus-score-index is used as a free variable.
+ alike last this art entries alist articles
+ fuzzies arts words kill)
+
+ ;; Sorting the articles costs os O(N*log N) but will allow us to
+ ;; only match with each unique header. Thus the actual matching
+ ;; will be O(M*U) where M is the number of strings to match with,
+ ;; and U is the number of unique headers. It is assumed (but
+ ;; untested) this will be a net win because of the large constant
+ ;; factor involved with string matching.
+ (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
+ articles gnus-scores-articles)
+
+ (erase-buffer)
+ (while (setq art (pop articles))
+ (setq this (aref (car art) gnus-score-index))
+ (if (equal last this)
+ ;; O(N*H) cons-cells used here, where H is the number of
+ ;; headers.
+ (push art alike)
+ (when last
+ ;; Insert the line, with a text property on the
+ ;; terminating newline referring to the articles with
+ ;; this line.
+ (insert last ?\n)
+ (put-text-property (1- (point)) (point) 'articles alike))
+ (setq alike (list art)
+ last this)))
+ (when last ; Bwadr, duplicate code.
+ (insert last ?\n)
+ (put-text-property (1- (point)) (point) 'articles alike))
+
+ ;; Go through all the score alists and pick out the entries
+ ;; for this header.
+ (while score-list
+ (setq alist (pop score-list)
+ ;; There's only one instance of this header for
+ ;; each score alist.
+ entries (assoc header alist))
+ (while (cdr entries) ;First entry is the header index.
+ (let* ((kill (cadr entries))
+ (match (nth 0 kill))
+ (type (or (nth 3 kill) 's))
+ (score (or (nth 1 kill) gnus-score-interactive-default-score))
+ (date (nth 2 kill))
+ (found nil)
+ (mt (aref (symbol-name type) 0))
+ (case-fold-search (not (memq mt '(?R ?S ?E ?F))))
+ (dmt (downcase mt))
+ (search-func
+ (cond ((= dmt ?r) 're-search-forward)
+ ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
+ ((= dmt ?w) nil)
+ (t (error "Illegal match type: %s" type)))))
+ (cond
+ ;; Fuzzy matches. We save these for later.
+ ((= dmt ?f)
+ (push (cons entries alist) fuzzies))
+ ;; Word matches. Save these for even later.
+ ((= dmt ?w)
+ (push (cons entries alist) words))
+ ;; Exact matches.
+ ((= dmt ?e)
+ ;; Do exact matching.
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (funcall search-func match nil t))
+ ;; Is it really exact?
+ (and (eolp)
+ (= (gnus-point-at-bol) (match-beginning 0))
+ ;; Yup.
+ (progn
+ (setq found (setq arts (get-text-property
+ (point) 'articles)))
+ ;; Found a match, update scores.
+ (if trace
+ (while (setq art (pop arts))
+ (setcdr art (+ score (cdr art)))
+ (push
+ (cons
+ (car-safe (rassq alist gnus-score-cache))
+ kill)
+ gnus-score-trace))
+ (while (setq art (pop arts))
+ (setcdr art (+ score (cdr art)))))))
+ (forward-line 1)))
+ ;; Regexp and substring matching.
+ (t
+ (goto-char (point-min))
+ (when (string= match "")
+ (setq match "\n"))
+ (while (and (not (eobp))
+ (funcall search-func match nil t))
+ (goto-char (match-beginning 0))
+ (end-of-line)
+ (setq found (setq arts (get-text-property (point) 'articles)))
+ ;; Found a match, update scores.
+ (if trace
+ (while (setq art (pop arts))
+ (setcdr art (+ score (cdr art)))
+ (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
+ gnus-score-trace))
+ (while (setq art (pop arts))
+ (setcdr art (+ score (cdr art)))))
+ (forward-line 1))))
+ ;; Update expiry date
+ (if trace
+ (setq entries (cdr entries))
+ (cond
+ ;; Permanent entry.
+ ((null date)
+ (setq entries (cdr entries)))
+ ;; We have a match, so we update the date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now)
+ (setq entries (cdr entries)))
+ ;; This entry has expired, so we remove it.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cddr entries)))
+ ;; No match; go to next entry.
+ (t
+ (setq entries (cdr entries))))))))
+
+ ;; Find fuzzy matches.
+ (when fuzzies
+ ;; Simplify the entire buffer for easy matching.
+ (gnus-simplify-buffer-fuzzy)
+ (while (setq kill (cadaar fuzzies))
+ (let* ((match (nth 0 kill))
+ (type (nth 3 kill))
+ (score (or (nth 1 kill) gnus-score-interactive-default-score))
+ (date (nth 2 kill))
+ (mt (aref (symbol-name type) 0))
+ (case-fold-search (not (= mt ?F)))
+ found)
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (search-forward match nil t))
+ (when (and (= (gnus-point-at-bol) (match-beginning 0))
+ (eolp))
+ (setq found (setq arts (get-text-property (point) 'articles)))
+ (if trace
+ (while (setq art (pop arts))
+ (setcdr art (+ score (cdr art)))
+ (push (cons
+ (car-safe (rassq (cdar fuzzies) gnus-score-cache))
+ kill)
+ gnus-score-trace))
+ ;; Found a match, update scores.
+ (while (setq art (pop arts))
+ (setcdr art (+ score (cdr art))))))
+ (forward-line 1))
+ ;; Update expiry date
+ (cond
+ ;; Permanent.
+ ((null date)
+ )
+ ;; Match, update date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) (cdar fuzzies))
+ (setcar (nthcdr 2 kill) now))
+ ;; Old entry, remove.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) (cdar fuzzies))
+ (setcdr (caar fuzzies) (cddaar fuzzies))))
+ (setq fuzzies (cdr fuzzies)))))
+
+ (when words
+ ;; Enter all words into the hashtb.
+ (let ((hashtb (gnus-make-hashtable
+ (* 10 (count-lines (point-min) (point-max))))))
+ (gnus-enter-score-words-into-hashtb hashtb)
+ (while (setq kill (cadaar words))
+ (let* ((score (or (nth 1 kill) gnus-score-interactive-default-score))
+ (date (nth 2 kill))
+ found)
+ (when (setq arts (intern-soft (nth 0 kill) hashtb))
+ (setq arts (symbol-value arts))
+ (setq found t)
+ (if trace
+ (while (setq art (pop arts))
+ (setcdr art (+ score (cdr art)))
+ (push (cons
+ (car-safe (rassq (cdar words) gnus-score-cache))
+ kill)
+ gnus-score-trace))
+ ;; Found a match, update scores.
+ (while (setq art (pop arts))
+ (setcdr art (+ score (cdr art))))))
+ ;; Update expiry date
+ (cond
+ ;; Permanent.
+ ((null date)
+ )
+ ;; Match, update date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) (cdar words))
+ (setcar (nthcdr 2 kill) now))
+ ;; Old entry, remove.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) (cdar words))
+ (setcdr (caar words) (cddaar words))))
+ (setq words (cdr words))))))
+ nil))
+
+(defun gnus-enter-score-words-into-hashtb (hashtb)
+ ;; Find all the words in the buffer and enter them into
+ ;; the hashtable.
+ (let ((syntab (syntax-table))
+ word val)
+ (goto-char (point-min))
+ (unwind-protect
+ (progn
+ (set-syntax-table gnus-adaptive-word-syntax-table)
+ (while (re-search-forward "\\b\\w+\\b" nil t)
+ (setq val
+ (gnus-gethash
+ (setq word (downcase (buffer-substring
+ (match-beginning 0) (match-end 0))))
+ hashtb))
+ (gnus-sethash
+ word
+ (append (get-text-property (gnus-point-at-eol) 'articles) val)
+ hashtb)))
+ (set-syntax-table syntab))
+ ;; Make all the ignorable words ignored.
+ (let ((ignored (append gnus-ignored-adaptive-words
+ gnus-default-ignored-adaptive-words)))
+ (while ignored
+ (gnus-sethash (pop ignored) nil hashtb)))))
+
+(defun gnus-score-string< (a1 a2)
+ ;; Compare headers in articles A2 and A2.
+ ;; The header index used is the free variable `gnus-score-index'.
+ (string-lessp (aref (car a1) gnus-score-index)
+ (aref (car a2) gnus-score-index)))
+
+(defun gnus-current-score-file-nondirectory (&optional score-file)
+ (let ((score-file (or score-file gnus-current-score-file)))
+ (if score-file
+ (gnus-short-group-name (file-name-nondirectory score-file))
+ "none")))
+
+(defun gnus-score-adaptive ()
+ "Create adaptive score rules for this newsgroup."
+ (when gnus-newsgroup-adaptive
+ ;; We change the score file to the adaptive score file.
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-score-load-file
+ (or gnus-newsgroup-adaptive-score-file
+ (gnus-score-file-name
+ gnus-newsgroup-name gnus-adaptive-file-suffix))))
+ ;; Perform ordinary line scoring.
+ (when (or (not (listp gnus-newsgroup-adaptive))
+ (memq 'line gnus-newsgroup-adaptive))
+ (save-excursion
+ (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
+ (alist malist)
+ (date (current-time-string))
+ (data gnus-newsgroup-data)
+ elem headers match)
+ ;; First we transform the adaptive rule alist into something
+ ;; that's faster to process.
+ (while malist
+ (setq elem (car malist))
+ (when (symbolp (car elem))
+ (setcar elem (symbol-value (car elem))))
+ (setq elem (cdr elem))
+ (while elem
+ (setcdr (car elem)
+ (cons (if (eq (caar elem) 'followup)
+ "references"
+ (symbol-name (caar elem)))
+ (cdar elem)))
+ (setcar (car elem)
+ `(lambda (h)
+ (,(intern
+ (concat "mail-header-"
+ (if (eq (caar elem) 'followup)
+ "message-id"
+ (downcase (symbol-name (caar elem))))))
+ h)))
+ (setq elem (cdr elem)))
+ (setq malist (cdr malist)))
+ ;; Then we score away.
+ (while data
+ (setq elem (cdr (assq (gnus-data-mark (car data)) alist)))
+ (if (or (not elem)
+ (gnus-data-pseudo-p (car data)))
+ ()
+ (when (setq headers (gnus-data-header (car data)))
+ (while elem
+ (setq match (funcall (caar elem) headers))
+ (gnus-summary-score-entry
+ (nth 1 (car elem)) match
+ (cond
+ ((numberp match)
+ '=)
+ ((equal (nth 1 (car elem)) "date")
+ 'a)
+ (t
+ ;; Whether we use substring or exact matches is
+ ;; controlled here.
+ (if (or (not gnus-score-exact-adapt-limit)
+ (< (length match) gnus-score-exact-adapt-limit))
+ 'e
+ (if (equal (nth 1 (car elem)) "subject")
+ 'f 's))))
+ (nth 2 (car elem)) date nil t)
+ (setq elem (cdr elem)))))
+ (setq data (cdr data))))))
+
+ ;; Perform adaptive word scoring.
+ (when (and (listp gnus-newsgroup-adaptive)
+ (memq 'word gnus-newsgroup-adaptive))
+ (nnheader-temp-write nil
+ (let* ((hashtb (gnus-make-hashtable 1000))
+ (date (gnus-day-number (current-time-string)))
+ (data gnus-newsgroup-data)
+ (syntab (syntax-table))
+ word d score val)
+ (unwind-protect
+ (progn
+ (set-syntax-table gnus-adaptive-word-syntax-table)
+ ;; Go through all articles.
+ (while (setq d (pop data))
+ (when (and
+ (not (gnus-data-pseudo-p d))
+ (setq score
+ (cdr (assq
+ (gnus-data-mark d)
+ gnus-adaptive-word-score-alist))))
+ ;; This article has a mark that should lead to
+ ;; adaptive word rules, so we insert the subject
+ ;; and find all words in that string.
+ (insert (mail-header-subject (gnus-data-header d)))
+ (downcase-region (point-min) (point-max))
+ (goto-char (point-min))
+ (while (re-search-forward "\\b\\w+\\b" nil t)
+ ;; Put the word and score into the hashtb.
+ (setq val (gnus-gethash (setq word (match-string 0))
+ hashtb))
+ (gnus-sethash word (+ (or val 0) score) hashtb))
+ (erase-buffer))))
+ (set-syntax-table syntab))
+ ;; Make all the ignorable words ignored.
+ (let ((ignored (append gnus-ignored-adaptive-words
+ gnus-default-ignored-adaptive-words)))
+ (while ignored
+ (gnus-sethash (pop ignored) nil hashtb)))
+ ;; Now we have all the words and scores, so we
+ ;; add these rules to the ADAPT file.
+ (set-buffer gnus-summary-buffer)
+ (mapatoms
+ (lambda (word)
+ (when (symbol-value word)
+ (gnus-summary-score-entry
+ "subject" (symbol-name word) 'w (symbol-value word)
+ date nil t)))
+ hashtb))))))
+
+(defun gnus-score-edit-done ()
+ (let ((bufnam (buffer-file-name (current-buffer)))
+ (winconf gnus-prev-winconf))
+ (when winconf
+ (set-window-configuration winconf))
+ (gnus-score-remove-from-cache bufnam)
+ (gnus-score-load-file bufnam)))
+
+(defun gnus-score-find-trace ()
+ "Find all score rules that applies to the current article."
+ (interactive)
+ (let ((old-scored gnus-newsgroup-scored))
+ (let ((gnus-newsgroup-headers
+ (list (gnus-summary-article-header)))
+ (gnus-newsgroup-scored nil)
+ trace)
+ (save-excursion
+ (nnheader-set-temp-buffer "*Score Trace*"))
+ (setq gnus-score-trace nil)
+ (gnus-possibly-score-headers 'trace)
+ (if (not (setq trace gnus-score-trace))
+ (gnus-error
+ 1 "No score rules apply to the current article (default score %d)."
+ gnus-summary-default-score)
+ (set-buffer "*Score Trace*")
+ (gnus-add-current-to-buffer-list)
+ (while trace
+ (insert (format "%S -> %s\n" (cdar trace)
+ (if (caar trace)
+ (file-name-nondirectory (caar trace))
+ "(non-file rule)")))
+ (setq trace (cdr trace)))
+ (goto-char (point-min))
+ (gnus-configure-windows 'score-trace)))
+ (set-buffer gnus-summary-buffer)
+ (setq gnus-newsgroup-scored old-scored)))
+
+(defun gnus-score-find-favourite-words ()
+ "List words used in scoring."
+ (interactive)
+ (let ((alists (gnus-score-load-files (gnus-all-score-files)))
+ alist rule rules kill)
+ ;; Go through all the score alists for this group
+ ;; and find all `w' rules.
+ (while (setq alist (pop alists))
+ (while (setq rule (pop alist))
+ (when (and (stringp (car rule))
+ (equal "subject" (downcase (pop rule))))
+ (while (setq kill (pop rule))
+ (when (memq (nth 3 kill) '(w W word Word))
+ (push (cons (or (nth 1 kill)
+ gnus-score-interactive-default-score)
+ (car kill))
+ rules))))))
+ (setq rules (sort rules (lambda (r1 r2)
+ (string-lessp (cdr r1) (cdr r2)))))
+ ;; Add up words that have appeared several times.
+ (let ((r rules))
+ (while (cdr r)
+ (if (equal (cdar r) (cdadr r))
+ (progn
+ (setcar (car r) (+ (caar r) (caadr r)))
+ (setcdr r (cddr r)))
+ (pop r))))
+ ;; Insert the words.
+ (nnheader-set-temp-buffer "*Score Words*")
+ (if (not (setq rules (sort rules (lambda (r1 r2) (> (car r1) (car r2))))))
+ (gnus-error 3 "No word score rules")
+ (while rules
+ (insert (format "%-5d: %s\n" (caar rules) (cdar rules)))
+ (pop rules))
+ (gnus-add-current-to-buffer-list)
+ (goto-char (point-min))
+ (gnus-configure-windows 'score-words))))
+
+(defun gnus-summary-rescore ()
+ "Redo the entire scoring process in the current summary."
+ (interactive)
+ (gnus-score-save)
+ (setq gnus-score-cache nil)
+ (setq gnus-newsgroup-scored nil)
+ (gnus-possibly-score-headers)
+ (gnus-score-update-all-lines))
+
+(defun gnus-score-flush-cache ()
+ "Flush the cache of score files."
+ (interactive)
+ (gnus-score-save)
+ (setq gnus-score-cache nil
+ gnus-score-alist nil
+ gnus-short-name-score-file-cache nil)
+ (gnus-message 6 "The score cache is now flushed"))
+
+(gnus-add-shutdown 'gnus-score-close 'gnus)
+
+(defvar gnus-score-file-alist-cache nil)
+
+(defun gnus-score-close ()
+ "Clear all internal score variables."
+ (setq gnus-score-cache nil
+ gnus-internal-global-score-files nil
+ gnus-score-file-list nil
+ gnus-score-file-alist-cache nil))
+
+;; Summary score marking commands.
+
+(defun gnus-summary-raise-same-subject-and-select (score)
+ "Raise articles which has the same subject with SCORE and select the next."
+ (interactive "p")
+ (let ((subject (gnus-summary-article-subject)))
+ (gnus-summary-raise-score score)
+ (while (gnus-summary-find-subject subject)
+ (gnus-summary-raise-score score))
+ (gnus-summary-next-article t)))
+
+(defun gnus-summary-raise-same-subject (score)
+ "Raise articles which has the same subject with SCORE."
+ (interactive "p")
+ (let ((subject (gnus-summary-article-subject)))
+ (gnus-summary-raise-score score)
+ (while (gnus-summary-find-subject subject)
+ (gnus-summary-raise-score score))
+ (gnus-summary-next-subject 1 t)))
+
+(defun gnus-score-default (level)
+ (if level (prefix-numeric-value level)
+ gnus-score-interactive-default-score))
+
+(defun gnus-summary-raise-thread (&optional score)
+ "Raise the score of the articles in the current thread with SCORE."
+ (interactive "P")
+ (setq score (gnus-score-default score))
+ (let (e)
+ (save-excursion
+ (let ((articles (gnus-summary-articles-in-thread)))
+ (while articles
+ (gnus-summary-goto-subject (car articles))
+ (gnus-summary-raise-score score)
+ (setq articles (cdr articles))))
+ (setq e (point)))
+ (let ((gnus-summary-check-current t))
+ (unless (zerop (gnus-summary-next-subject 1 t))
+ (goto-char e))))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary))
+
+(defun gnus-summary-lower-same-subject-and-select (score)
+ "Raise articles which has the same subject with SCORE and select the next."
+ (interactive "p")
+ (gnus-summary-raise-same-subject-and-select (- score)))
+
+(defun gnus-summary-lower-same-subject (score)
+ "Raise articles which has the same subject with SCORE."
+ (interactive "p")
+ (gnus-summary-raise-same-subject (- score)))
+
+(defun gnus-summary-lower-thread (&optional score)
+ "Lower score of articles in the current thread with SCORE."
+ (interactive "P")
+ (gnus-summary-raise-thread (- (1- (gnus-score-default score)))))
+
+;;; Finding score files.
+
+(defun gnus-score-score-files (group)
+ "Return a list of all possible score files."
+ ;; Search and set any global score files.
+ (when gnus-global-score-files
+ (unless gnus-internal-global-score-files
+ (gnus-score-search-global-directories gnus-global-score-files)))
+ ;; Fix the kill-file dir variable.
+ (setq gnus-kill-files-directory
+ (file-name-as-directory gnus-kill-files-directory))
+ ;; If we can't read it, there are no score files.
+ (if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
+ (setq gnus-score-file-list nil)
+ (if (not (gnus-use-long-file-name 'not-score))
+ ;; We do not use long file names, so we have to do some
+ ;; directory traversing.
+ (setq gnus-score-file-list
+ (cons nil
+ (or gnus-short-name-score-file-cache
+ (prog2
+ (gnus-message 6 "Finding all score files...")
+ (setq gnus-short-name-score-file-cache
+ (gnus-score-score-files-1
+ gnus-kill-files-directory))
+ (gnus-message 6 "Finding all score files...done")))))
+ ;; We want long file names.
+ (when (or (not gnus-score-file-list)
+ (not (car gnus-score-file-list))
+ (gnus-file-newer-than gnus-kill-files-directory
+ (car gnus-score-file-list)))
+ (setq gnus-score-file-list
+ (cons (nth 5 (file-attributes gnus-kill-files-directory))
+ (nreverse
+ (directory-files
+ gnus-kill-files-directory t
+ (gnus-score-file-regexp)))))))
+ (cdr gnus-score-file-list)))
+
+(defun gnus-score-score-files-1 (dir)
+ "Return all possible score files under DIR."
+ (let ((files (list (expand-file-name dir)))
+ (regexp (gnus-score-file-regexp))
+ (case-fold-search nil)
+ seen out file)
+ (while (setq file (pop files))
+ (cond
+ ;; Ignore "." and "..".
+ ((member (file-name-nondirectory file) '("." ".."))
+ nil)
+ ;; Add subtrees of directory to also be searched.
+ ((and (file-directory-p file)
+ (not (member (file-truename file) seen)))
+ (push (file-truename file) seen)
+ (setq files (nconc (directory-files file t nil t) files)))
+ ;; Add files to the list of score files.
+ ((string-match regexp file)
+ (push file out))))
+ (or out
+ ;; Return a dummy value.
+ (list "~/News/this.file.does.not.exist.SCORE"))))
+
+(defun gnus-score-file-regexp ()
+ "Return a regexp that match all score files."
+ (concat "\\(" (regexp-quote gnus-score-file-suffix )
+ "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'"))
+
+(defun gnus-score-find-bnews (group)
+ "Return a list of score files for GROUP.
+The score files are those files in the ~/News/ directory which matches
+GROUP using BNews sys file syntax."
+ (let* ((sfiles (append (gnus-score-score-files group)
+ gnus-internal-global-score-files))
+ (kill-dir (file-name-as-directory
+ (expand-file-name gnus-kill-files-directory)))
+ (klen (length kill-dir))
+ (score-regexp (gnus-score-file-regexp))
+ (trans (cdr (assq ?: nnheader-file-name-translation-alist)))
+ ofiles not-match regexp)
+ (save-excursion
+ (set-buffer (get-buffer-create "*gnus score files*"))
+ (buffer-disable-undo (current-buffer))
+ ;; Go through all score file names and create regexp with them
+ ;; as the source.
+ (while sfiles
+ (erase-buffer)
+ (insert (car sfiles))
+ (goto-char (point-min))
+ ;; First remove the suffix itself.
+ (when (re-search-forward (concat "." score-regexp) nil t)
+ (replace-match "" t t)
+ (goto-char (point-min))
+ (if (looking-at (regexp-quote kill-dir))
+ ;; If the file name was just "SCORE", `klen' is one character
+ ;; too much.
+ (delete-char (min (1- (point-max)) klen))
+ (goto-char (point-max))
+ (search-backward "/")
+ (delete-region (1+ (point)) (point-min)))
+ ;; If short file names were used, we have to translate slashes.
+ (goto-char (point-min))
+ (let ((regexp (concat
+ "[/:" (if trans (char-to-string trans) "") "]")))
+ (while (re-search-forward regexp nil t)
+ (replace-match "." t t)))
+ ;; Kludge to get rid of "nntp+" problems.
+ (goto-char (point-min))
+ (when (looking-at "nn[a-z]+\\+")
+ (search-forward "+")
+ (forward-char -1)
+ (insert "\\")
+ (forward-char 1))
+ ;; Kludge to deal with "++".
+ (while (search-forward "+" nil t)
+ (replace-match "\\+" t t))
+ ;; Translate "all" to ".*".
+ (goto-char (point-min))
+ (while (search-forward "all" nil t)
+ (replace-match ".*" t t))
+ (goto-char (point-min))
+ ;; Deal with "not."s.
+ (if (looking-at "not.")
+ (progn
+ (setq not-match t)
+ (setq regexp (concat "^" (buffer-substring 5 (point-max)) "$")))
+ (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$"))
+ (setq not-match nil))
+ ;; Finally - if this resulting regexp matches the group name,
+ ;; we add this score file to the list of score files
+ ;; applicable to this group.
+ (when (or (and not-match
+ (not (string-match regexp group)))
+ (and (not not-match)
+ (string-match regexp group)))
+ (push (car sfiles) ofiles)))
+ (setq sfiles (cdr sfiles)))
+ (kill-buffer (current-buffer))
+ ;; Slight kludge here - the last score file returned should be
+ ;; the local score file, whether it exists or not. This is so
+ ;; that any score commands the user enters will go to the right
+ ;; file, and not end up in some global score file.
+ (let ((localscore (gnus-score-file-name group)))
+ (setq ofiles (cons localscore (delete localscore ofiles))))
+ (gnus-sort-score-files (nreverse ofiles)))))
+
+(defun gnus-score-find-single (group)
+ "Return list containing the score file for GROUP."
+ (list (or gnus-newsgroup-adaptive-score-file
+ (gnus-score-file-name group gnus-adaptive-file-suffix))
+ (gnus-score-file-name group)))
+
+(defun gnus-score-find-hierarchical (group)
+ "Return list of score files for GROUP.
+This includes the score file for the group and all its parents."
+ (let* ((prefix (gnus-group-real-prefix group))
+ (all (list nil))
+ (group (gnus-group-real-name group))
+ (start 0))
+ (while (string-match "\\." group (1+ start))
+ (setq start (match-beginning 0))
+ (push (substring group 0 start) all))
+ (push group all)
+ (setq all
+ (nconc
+ (mapcar (lambda (group)
+ (gnus-score-file-name group gnus-adaptive-file-suffix))
+ (setq all (nreverse all)))
+ (mapcar 'gnus-score-file-name all)))
+ (if (equal prefix "")
+ all
+ (mapcar
+ (lambda (file)
+ (nnheader-translate-file-chars
+ (concat (file-name-directory file) prefix
+ (file-name-nondirectory file))))
+ all))))
+
+(defun gnus-score-file-rank (file)
+ "Return a number that says how specific score FILE is.
+Destroys the current buffer."
+ (if (member file gnus-internal-global-score-files)
+ 0
+ (when (string-match
+ (concat "^" (regexp-quote
+ (expand-file-name
+ (file-name-as-directory gnus-kill-files-directory))))
+ file)
+ (setq file (substring file (match-end 0))))
+ (insert file)
+ (goto-char (point-min))
+ (let ((beg (point))
+ elems)
+ (while (re-search-forward "[./]" nil t)
+ (push (buffer-substring beg (1- (point)))
+ elems))
+ (erase-buffer)
+ (setq elems (delete "all" elems))
+ (length elems))))
+
+(defun gnus-sort-score-files (files)
+ "Sort FILES so that the most general files come first."
+ (nnheader-temp-write nil
+ (let ((alist
+ (mapcar
+ (lambda (file)
+ (cons (inline (gnus-score-file-rank file)) file))
+ files)))
+ (mapcar
+ (lambda (f) (cdr f))
+ (sort alist 'car-less-than-car)))))
+
+(defun gnus-score-find-alist (group)
+ "Return list of score files for GROUP.
+The list is determined from the variable gnus-score-file-alist."
+ (let ((alist gnus-score-file-multiple-match-alist)
+ score-files)
+ ;; if this group has been seen before, return the cached entry
+ (if (setq score-files (assoc group gnus-score-file-alist-cache))
+ (cdr score-files) ;ensures caching groups with no matches
+ ;; handle the multiple match alist
+ (while alist
+ (when (string-match (caar alist) group)
+ (setq score-files
+ (nconc score-files (copy-sequence (cdar alist)))))
+ (setq alist (cdr alist)))
+ (setq alist gnus-score-file-single-match-alist)
+ ;; handle the single match alist
+ (while alist
+ (when (string-match (caar alist) group)
+ ;; progn used just in case ("regexp") has no files
+ ;; and score-files is still nil. -sj
+ ;; this can be construed as a "stop searching here" feature :>
+ ;; and used to simplify regexps in the single-alist
+ (setq score-files
+ (nconc score-files (copy-sequence (cdar alist))))
+ (setq alist nil))
+ (setq alist (cdr alist)))
+ ;; cache the score files
+ (push (cons group score-files) gnus-score-file-alist-cache)
+ score-files)))
+
+(defun gnus-all-score-files (&optional group)
+ "Return a list of all score files for the current group."
+ (let ((funcs gnus-score-find-score-files-function)
+ (group (or group gnus-newsgroup-name))
+ score-files)
+ ;; Make sure funcs is a list.
+ (and funcs
+ (not (listp funcs))
+ (setq funcs (list funcs)))
+ ;; Get the initial score files for this group.
+ (when funcs
+ (setq score-files (nreverse (gnus-score-find-alist group))))
+ ;; Add any home adapt files.
+ (let ((home (gnus-home-score-file group t)))
+ (when home
+ (push home score-files)
+ (setq gnus-newsgroup-adaptive-score-file home)))
+ ;; Check whether there is a `adapt-file' group parameter.
+ (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
+ (when param-file
+ (push param-file score-files)
+ (setq gnus-newsgroup-adaptive-score-file param-file)))
+ ;; Go through all the functions for finding score files (or actual
+ ;; scores) and add them to a list.
+ (while funcs
+ (when (gnus-functionp (car funcs))
+ (setq score-files
+ (nconc score-files (nreverse (funcall (car funcs) group)))))
+ (setq funcs (cdr funcs)))
+ ;; Add any home score files.
+ (let ((home (gnus-home-score-file group)))
+ (when home
+ (push home score-files)))
+ ;; Check whether there is a `score-file' group parameter.
+ (let ((param-file (gnus-group-find-parameter group 'score-file)))
+ (when param-file
+ (push param-file score-files)))
+ ;; Expand all files names.
+ (let ((files score-files))
+ (while files
+ (when (stringp (car files))
+ (setcar files (expand-file-name
+ (car files) gnus-kill-files-directory)))
+ (pop files)))
+ (setq score-files (nreverse score-files))
+ ;; Remove any duplicate score files.
+ (while (and score-files
+ (member (car score-files) (cdr score-files)))
+ (pop score-files))
+ (let ((files score-files))
+ (while (cdr files)
+ (if (member (cadr files) (cddr files))
+ (setcdr files (cddr files))
+ (pop files))))
+ ;; Do the scoring if there are any score files for this group.
+ score-files))
+
+(defun gnus-possibly-score-headers (&optional trace)
+ "Do scoring if scoring is required."
+ (let ((score-files (gnus-all-score-files)))
+ (when score-files
+ (gnus-score-headers score-files trace))))
+
+(defun gnus-score-file-name (newsgroup &optional suffix)
+ "Return the name of a score file for NEWSGROUP."
+ (let ((suffix (or suffix gnus-score-file-suffix)))
+ (nnheader-translate-file-chars
+ (cond
+ ((or (null newsgroup)
+ (string-equal newsgroup ""))
+ ;; The global score file is placed at top of the directory.
+ (expand-file-name
+ suffix gnus-kill-files-directory))
+ ((gnus-use-long-file-name 'not-score)
+ ;; Append ".SCORE" to newsgroup name.
+ (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
+ "." suffix)
+ gnus-kill-files-directory))
+ (t
+ ;; Place "SCORE" under the hierarchical directory.
+ (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
+ "/" suffix)
+ gnus-kill-files-directory))))))
+
+(defun gnus-score-search-global-directories (files)
+ "Scan all global score directories for score files."
+ ;; Set the variable `gnus-internal-global-score-files' to all
+ ;; available global score files.
+ (interactive (list gnus-global-score-files))
+ (let (out)
+ (while files
+ (if (string-match "/$" (car files))
+ (setq out (nconc (directory-files
+ (car files) t
+ (concat (gnus-score-file-regexp) "$"))))
+ (push (car files) out))
+ (setq files (cdr files)))
+ (setq gnus-internal-global-score-files out)))
+
+(defun gnus-score-default-fold-toggle ()
+ "Toggle folding for new score file entries."
+ (interactive)
+ (setq gnus-score-default-fold (not gnus-score-default-fold))
+ (if gnus-score-default-fold
+ (gnus-message 1 "New score file entries will be case insensitive.")
+ (gnus-message 1 "New score file entries will be case sensitive.")))
+
+;;; Home score file.
+
+(defun gnus-home-score-file (group &optional adapt)
+ "Return the home score file for GROUP.
+If ADAPT, return the home adaptive file instead."
+ (let ((list (if adapt gnus-home-adapt-file gnus-home-score-file))
+ elem found)
+ ;; Make sure we have a list.
+ (unless (listp list)
+ (setq list (list list)))
+ ;; Go through the list and look for matches.
+ (while (and (not found)
+ (setq elem (pop list)))
+ (setq found
+ (cond
+ ;; Simple string.
+ ((stringp elem)
+ elem)
+ ;; Function.
+ ((gnus-functionp elem)
+ (funcall elem group))
+ ;; Regexp-file cons
+ ((consp elem)
+ (when (string-match (car elem) group)
+ (cadr elem))))))
+ (when found
+ (nnheader-concat gnus-kill-files-directory found))))
+
+(defun gnus-hierarchial-home-score-file (group)
+ "Return the score file of the top-level hierarchy of GROUP."
+ (if (string-match "^[^.]+\\." group)
+ (concat (match-string 0 group) gnus-score-file-suffix)
+ ;; Group name without any dots.
+ (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
+ gnus-score-file-suffix)))
+
+(defun gnus-hierarchial-home-adapt-file (group)
+ "Return the adapt file of the top-level hierarchy of GROUP."
+ (if (string-match "^[^.]+\\." group)
+ (concat (match-string 0 group) gnus-adaptive-file-suffix)
+ ;; Group name without any dots.
+ (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
+ gnus-adaptive-file-suffix)))
+
+;;;
+;;; Score decays
+;;;
+
+(defun gnus-decay-score (score)
+ "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'."
+ (floor
+ (- score
+ (* (if (< score 0) -1 1)
+ (min (abs score)
+ (max gnus-score-decay-constant
+ (* (abs score)
+ gnus-score-decay-scale)))))))
+
+(defun gnus-decay-scores (alist day)
+ "Decay non-permanent scores in ALIST."
+ (let ((times (- (gnus-time-to-day (current-time)) day))
+ kill entry updated score n)
+ (unless (zerop times) ;Done decays today already?
+ (while (setq entry (pop alist))
+ (when (stringp (car entry))
+ (setq entry (cdr entry))
+ (while (setq kill (pop entry))
+ (when (nth 2 kill)
+ (setq updated t)
+ (setq score (or (nth 1 kill)
+ gnus-score-interactive-default-score)
+ n times)
+ (while (natnump (decf n))
+ (setq score (funcall gnus-decay-score-function score)))
+ (setcdr kill (cons score
+ (cdr (cdr kill)))))))))
+ ;; Return whether this score file needs to be saved. By Je-haysuss!
+ updated))
+
+(defun gnus-score-regexp-bad-p (regexp)
+ "Test whether REGEXP is safe for Gnus scoring.
+A regexp is unsafe if it matches newline or a buffer boundary.
+
+If the regexp is good, return nil. If the regexp is bad, return a
+cons cell (SYM . STRING), where the symbol SYM is `new' or `bad'.
+In the `new' case, the string is a safe replacement for REGEXP.
+In the `bad' case, the string is a unsafe subexpression of REGEXP,
+and we do not have a simple replacement to suggest.
+
+See `(Gnus)Scoring Tips' for examples of good regular expressions."
+ (let (case-fold-search)
+ (and
+ ;; First, try a relatively fast necessary condition.
+ ;; Notice ranges (like [^:] or [\t-\r]), \s>, \Sw, \W, \', \`:
+ (string-match "\n\\|\\\\[SsW`']\\|\\[\\^\\|[\0-\n]-" regexp)
+ ;; Now break the regexp into tokens, and check each:
+ (let ((tail regexp) ; remaining regexp to check
+ tok ; current token
+ bad ; nil, or bad subexpression
+ new ; nil, or replacement regexp so far
+ end) ; length of current token
+ (while (and (not bad)
+ (string-match
+ "\\`\\(\\\\[sS]?.\\|\\[\\^?]?[^]]*]\\|[^\\]\\)"
+ tail))
+ (setq end (match-end 0)
+ tok (substring tail 0 end)
+ tail (substring tail end))
+ (if;; Is token `bad' (matching newline or buffer ends)?
+ (or (member tok '("\n" "\\W" "\\`" "\\'"))
+ ;; This next handles "[...]", "\\s.", and "\\S.":
+ (and (> end 2) (string-match tok "\n")))
+ (let ((newtok
+ ;; Try to suggest a replacement for tok ...
+ (cond ((string-equal tok "\\`") "^") ; or "\\(^\\)"
+ ((string-equal tok "\\'") "$") ; or "\\($\\)"
+ ((string-match "\\[\\^" tok) ; very common
+ (concat (substring tok 0 -1) "\n]")))))
+ (if newtok
+ (setq new
+ (concat
+ (or new
+ ;; good prefix so far:
+ (substring regexp 0 (- (+ (length tail) end))))
+ newtok))
+ ;; No replacement idea, so give up:
+ (setq bad tok)))
+ ;; tok is good, may need to extend new
+ (and new (setq new (concat new tok)))))
+ ;; Now return a value:
+ (cond
+ (bad (cons 'bad bad))
+ (new (cons 'new new))
+ ;; or nil
+ )))))
+
+(provide 'gnus-score)
+
+;;; gnus-score.el ends here
--- /dev/null
+;;; gnus-setup.el --- Initialization & Setup for Gnus 5
+;; Copyright (C) 1995, 96 Free Software Foundation, Inc.
+
+;; Author: Steven L. Baur <steve@miranova.com>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;; My head is starting to spin with all the different mail/news packages.
+;; Stop The Madness!
+
+;; Given that Emacs Lisp byte codes may be diverging, it is probably best
+;; not to byte compile this, and just arrange to have the .el loaded out
+;; of .emacs.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
+
+(defvar gnus-use-installed-gnus t
+ "*If non-nil Use installed version of Gnus.")
+
+(defvar gnus-use-installed-tm running-xemacs
+ "*If non-nil use installed version of tm.")
+
+(defvar gnus-use-installed-mailcrypt running-xemacs
+ "*If non-nil use installed version of mailcrypt.")
+
+(defvar gnus-emacs-lisp-directory (if running-xemacs
+ "/usr/local/lib/xemacs/"
+ "/usr/local/share/emacs/")
+ "Directory where Emacs site lisp is located.")
+
+(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory
+ "gnus-5.0.15/lisp/")
+ "Directory where Gnus Emacs lisp is found.")
+
+(defvar gnus-tm-lisp-directory (concat gnus-emacs-lisp-directory
+ "site-lisp/")
+ "Directory where TM Emacs lisp is found.")
+
+(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory
+ "site-lisp/mailcrypt-3.4/")
+ "Directory where Mailcrypt Emacs Lisp is found.")
+
+(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory
+ "site-lisp/bbdb-1.51/")
+ "Directory where Big Brother Database is found.")
+
+(defvar gnus-use-tm running-xemacs
+ "Set this if you want MIME support for Gnus")
+(defvar gnus-use-mhe nil
+ "Set this if you want to use MH-E for mail reading")
+(defvar gnus-use-rmail nil
+ "Set this if you want to use RMAIL for mail reading")
+(defvar gnus-use-sendmail t
+ "Set this if you want to use SENDMAIL for mail reading")
+(defvar gnus-use-vm nil
+ "Set this if you want to use the VM package for mail reading")
+(defvar gnus-use-sc nil
+ "Set this if you want to use Supercite")
+(defvar gnus-use-mailcrypt t
+ "Set this if you want to use Mailcrypt for dealing with PGP messages")
+(defvar gnus-use-bbdb nil
+ "Set this if you want to use the Big Brother DataBase")
+
+(when (and (not gnus-use-installed-gnus)
+ (null (member gnus-gnus-lisp-directory load-path)))
+ (push gnus-gnus-lisp-directory load-path))
+
+;;; We can't do this until we know where Gnus is.
+(require 'message)
+
+;;; Tools for MIME by
+;;; UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
+;;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+(when gnus-use-tm
+ (when (and (not gnus-use-installed-tm)
+ (null (member gnus-tm-lisp-directory load-path)))
+ (setq load-path (cons gnus-tm-lisp-directory load-path)))
+ ;; tm may or may not be dumped with XEmacs. In Sunpro it is, otherwise
+ ;; it isn't.
+ (unless (featurep 'mime-setup)
+ (load "mime-setup")))
+
+;;; Mailcrypt by
+;;; Jin Choi <jin@atype.com>
+;;; Patrick LoPresti <patl@lcs.mit.edu>
+
+(when gnus-use-mailcrypt
+ (when (and (not gnus-use-installed-mailcrypt)
+ (null (member gnus-mailcrypt-lisp-directory load-path)))
+ (setq load-path (cons gnus-mailcrypt-lisp-directory load-path)))
+ (autoload 'mc-install-write-mode "mailcrypt" nil t)
+ (autoload 'mc-install-read-mode "mailcrypt" nil t)
+ (add-hook 'message-mode-hook 'mc-install-write-mode)
+ (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode)
+ (when gnus-use-mhe
+ (add-hook 'mh-folder-mode-hook 'mc-install-read-mode)
+ (add-hook 'mh-letter-mode-hook 'mc-install-write-mode)))
+
+;;; BBDB by
+;;; Jamie Zawinski <jwz@lucid.com>
+
+(when gnus-use-bbdb
+ ;; bbdb will never be installed with emacs.
+ (when (null (member gnus-bbdb-lisp-directory load-path))
+ (setq load-path (cons gnus-bbdb-lisp-directory load-path)))
+ (autoload 'bbdb "bbdb-com"
+ "Insidious Big Brother Database" t)
+ (autoload 'bbdb-name "bbdb-com"
+ "Insidious Big Brother Database" t)
+ (autoload 'bbdb-company "bbdb-com"
+ "Insidious Big Brother Database" t)
+ (autoload 'bbdb-net "bbdb-com"
+ "Insidious Big Brother Database" t)
+ (autoload 'bbdb-notes "bbdb-com"
+ "Insidious Big Brother Database" t)
+
+ (when gnus-use-vm
+ (autoload 'bbdb-insinuate-vm "bbdb-vm"
+ "Hook BBDB into VM" t))
+
+ (when gnus-use-rmail
+ (autoload 'bbdb-insinuate-rmail "bbdb-rmail"
+ "Hook BBDB into RMAIL" t)
+ (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail))
+
+ (when gnus-use-mhe
+ (autoload 'bbdb-insinuate-mh "bbdb-mh"
+ "Hook BBDB into MH-E" t)
+ (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh))
+
+ (autoload 'bbdb-insinuate-gnus "bbdb-gnus"
+ "Hook BBDB into Gnus" t)
+ (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
+
+ (when gnus-use-sendmail
+ (autoload 'bbdb-insinuate-sendmail "bbdb"
+ "Insidious Big Brother Database" t)
+ (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)
+ (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail)))
+
+(when gnus-use-sc
+ (add-hook 'mail-citation-hook 'sc-cite-original)
+ (setq message-cite-function 'sc-cite-original)
+ (autoload 'sc-cite-original "supercite"))
+\f
+;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137))
+;;; Generated autoloads from lisp/gnus.el
+
+;; Don't redo this if autoloads already exist
+(unless (fboundp 'gnus)
+ (autoload 'gnus-slave-no-server "gnus" "\
+Read network news as a slave without connecting to local server." t nil)
+
+ (autoload 'gnus-no-server "gnus" "\
+Read network news.
+If ARG is a positive number, Gnus will use that as the
+startup level. If ARG is nil, Gnus will be started at level 2.
+If ARG is non-nil and not a positive number, Gnus will
+prompt the user for the name of an NNTP server to use.
+As opposed to `gnus', this command will not connect to the local server." t nil)
+
+ (autoload 'gnus-slave "gnus" "\
+Read news as a slave." t nil)
+
+ (autoload 'gnus "gnus" "\
+Read network news.
+If ARG is non-nil and a positive number, Gnus will use that as the
+startup level. If ARG is non-nil and not a positive number, Gnus will
+prompt the user for the name of an NNTP server to use." t nil)
+
+;;;***
+
+;;; These have moved out of gnus.el into other files.
+;;; FIX FIX FIX: should other things be in gnus-setup? or these not in it?
+ (autoload 'gnus-update-format "gnus-spec" "\
+Update the format specification near point." t nil)
+
+ (autoload 'gnus-fetch-group "gnus-group" "\
+Start Gnus if necessary and enter GROUP.
+Returns whether the fetching was successful or not." t nil)
+
+ (defalias 'gnus-batch-kill 'gnus-batch-score)
+
+ (autoload 'gnus-batch-score "gnus-kill" "\
+Run batched scoring.
+Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
+Newsgroups is a list of strings in Bnews format. If you want to score
+the comp hierarchy, you'd say \"comp.all\". If you would not like to
+score the alt hierarchy, you'd say \"!alt.all\"." t nil))
+
+(provide 'gnus-setup)
+
+(run-hooks 'gnus-setup-load-hook)
+
+;;; gnus-setup.el ends here
--- /dev/null
+;;; gnus-soup.el --- SOUP packet writing support for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-art)
+(require 'message)
+(require 'gnus-start)
+(require 'gnus-range)
+
+;;; User Variables:
+
+(defvar gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/")
+ "*Directory containing an unpacked SOUP packet.")
+
+(defvar gnus-soup-replies-directory
+ (nnheader-concat gnus-soup-directory "SoupReplies/")
+ "*Directory where Gnus will do processing of replies.")
+
+(defvar gnus-soup-prefix-file "gnus-prefix"
+ "*Name of the file where Gnus stores the last used prefix.")
+
+(defvar gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz"
+ "Format string command for packing a SOUP packet.
+The SOUP files will be inserted where the %s is in the string.
+This string MUST contain both %s and %d. The file number will be
+inserted where %d appears.")
+
+(defvar gnus-soup-unpacker "gunzip -c %s | tar xvf -"
+ "*Format string command for unpacking a SOUP packet.
+The SOUP packet file name will be inserted at the %s.")
+
+(defvar gnus-soup-packet-directory gnus-home-directory
+ "*Where gnus-soup will look for REPLIES packets.")
+
+(defvar gnus-soup-packet-regexp "Soupin"
+ "*Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'.")
+
+(defvar gnus-soup-ignored-headers "^Xref:"
+ "*Regexp to match headers to be removed when brewing SOUP packets.")
+
+;;; Internal Variables:
+
+(defvar gnus-soup-encoding-type ?n
+ "*Soup encoding type.
+`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox
+format.")
+
+(defvar gnus-soup-index-type ?c
+ "*Soup index type.
+`n' means no index file and `c' means standard Cnews overview
+format.")
+
+(defvar gnus-soup-areas nil)
+(defvar gnus-soup-last-prefix nil)
+(defvar gnus-soup-prev-prefix nil)
+(defvar gnus-soup-buffers nil)
+
+;;; Access macros:
+
+(defmacro gnus-soup-area-prefix (area)
+ `(aref ,area 0))
+(defmacro gnus-soup-set-area-prefix (area prefix)
+ `(aset ,area 0 ,prefix))
+(defmacro gnus-soup-area-name (area)
+ `(aref ,area 1))
+(defmacro gnus-soup-area-encoding (area)
+ `(aref ,area 2))
+(defmacro gnus-soup-area-description (area)
+ `(aref ,area 3))
+(defmacro gnus-soup-area-number (area)
+ `(aref ,area 4))
+(defmacro gnus-soup-area-set-number (area value)
+ `(aset ,area 4 ,value))
+
+(defmacro gnus-soup-encoding-format (encoding)
+ `(aref ,encoding 0))
+(defmacro gnus-soup-encoding-index (encoding)
+ `(aref ,encoding 1))
+(defmacro gnus-soup-encoding-kind (encoding)
+ `(aref ,encoding 2))
+
+(defmacro gnus-soup-reply-prefix (reply)
+ `(aref ,reply 0))
+(defmacro gnus-soup-reply-kind (reply)
+ `(aref ,reply 1))
+(defmacro gnus-soup-reply-encoding (reply)
+ `(aref ,reply 2))
+
+;;; Commands:
+
+(defun gnus-soup-send-replies ()
+ "Unpack and send all replies in the reply packet."
+ (interactive)
+ (let ((packets (directory-files
+ gnus-soup-packet-directory t gnus-soup-packet-regexp)))
+ (while packets
+ (when (gnus-soup-send-packet (car packets))
+ (delete-file (car packets)))
+ (setq packets (cdr packets)))))
+
+(defun gnus-soup-add-article (n)
+ "Add the current article to SOUP packet.
+If N is a positive number, add the N next articles.
+If N is a negative number, add the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+move those articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let* ((articles (gnus-summary-work-articles n))
+ (tmp-buf (get-buffer-create "*soup work*"))
+ (area (gnus-soup-area gnus-newsgroup-name))
+ (prefix (gnus-soup-area-prefix area))
+ headers)
+ (buffer-disable-undo tmp-buf)
+ (save-excursion
+ (while articles
+ ;; Find the header of the article.
+ (set-buffer gnus-summary-buffer)
+ (when (setq headers (gnus-summary-article-header (car articles)))
+ ;; Put the article in a buffer.
+ (set-buffer tmp-buf)
+ (when (gnus-request-article-this-buffer
+ (car articles) gnus-newsgroup-name)
+ (save-restriction
+ (message-narrow-to-head)
+ (message-remove-header gnus-soup-ignored-headers t))
+ (gnus-soup-store gnus-soup-directory prefix headers
+ gnus-soup-encoding-type
+ gnus-soup-index-type)
+ (gnus-soup-area-set-number
+ area (1+ (or (gnus-soup-area-number area) 0)))))
+ ;; Mark article as read.
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-remove-process-mark (car articles))
+ (gnus-summary-mark-as-read (car articles) gnus-souped-mark)
+ (setq articles (cdr articles)))
+ (kill-buffer tmp-buf))
+ (gnus-soup-save-areas)))
+
+(defun gnus-soup-pack-packet ()
+ "Make a SOUP packet from the SOUP areas."
+ (interactive)
+ (gnus-soup-read-areas)
+ (unless (file-exists-p gnus-soup-directory)
+ (message "No such directory: %s" gnus-soup-directory))
+ (when (null (directory-files gnus-soup-directory nil "\\.MSG$"))
+ (message "No files to pack."))
+ (gnus-soup-pack gnus-soup-directory gnus-soup-packer))
+
+(defun gnus-group-brew-soup (n)
+ "Make a soup packet from the current group.
+Uses the process/prefix convention."
+ (interactive "P")
+ (let ((groups (gnus-group-process-prefix n)))
+ (while groups
+ (gnus-group-remove-mark (car groups))
+ (gnus-soup-group-brew (car groups) t)
+ (setq groups (cdr groups)))
+ (gnus-soup-save-areas)))
+
+(defun gnus-brew-soup (&optional level)
+ "Go through all groups on LEVEL or less and make a soup packet."
+ (interactive "P")
+ (let ((level (or level gnus-level-subscribed))
+ (newsrc (cdr gnus-newsrc-alist)))
+ (while newsrc
+ (when (<= (nth 1 (car newsrc)) level)
+ (gnus-soup-group-brew (caar newsrc) t))
+ (setq newsrc (cdr newsrc)))
+ (gnus-soup-save-areas)))
+
+;;;###autoload
+(defun gnus-batch-brew-soup ()
+ "Brew a SOUP packet from groups mention on the command line.
+Will use the remaining command line arguments as regular expressions
+for matching on group names.
+
+For instance, if you want to brew on all the nnml groups, as well as
+groups with \"emacs\" in the name, you could say something like:
+
+$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\""
+ (interactive)
+ nil)
+
+;;; Internal Functions:
+
+;; Store the current buffer.
+(defun gnus-soup-store (directory prefix headers format index)
+ ;; Create the directory, if needed.
+ (gnus-make-directory directory)
+ (let* ((msg-buf (nnheader-find-file-noselect
+ (concat directory prefix ".MSG")))
+ (idx-buf (if (= index ?n)
+ nil
+ (nnheader-find-file-noselect
+ (concat directory prefix ".IDX"))))
+ (article-buf (current-buffer))
+ from head-line beg type)
+ (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
+ (buffer-disable-undo msg-buf)
+ (when idx-buf
+ (push idx-buf gnus-soup-buffers)
+ (buffer-disable-undo idx-buf))
+ (save-excursion
+ ;; Make sure the last char in the buffer is a newline.
+ (goto-char (point-max))
+ (unless (= (current-column) 0)
+ (insert "\n"))
+ ;; Find the "from".
+ (goto-char (point-min))
+ (setq from
+ (gnus-mail-strip-quoted-names
+ (or (mail-fetch-field "from")
+ (mail-fetch-field "really-from")
+ (mail-fetch-field "sender"))))
+ (goto-char (point-min))
+ ;; Depending on what encoding is supposed to be used, we make
+ ;; a soup header.
+ (setq head-line
+ (cond
+ ((= gnus-soup-encoding-type ?n)
+ (format "#! rnews %d\n" (buffer-size)))
+ ((= gnus-soup-encoding-type ?m)
+ (while (search-forward "\nFrom " nil t)
+ (replace-match "\n>From " t t))
+ (concat "From " (or from "unknown")
+ " " (current-time-string) "\n"))
+ ((= gnus-soup-encoding-type ?M)
+ "\^a\^a\^a\^a\n")
+ (t (error "Unsupported type: %c" gnus-soup-encoding-type))))
+ ;; Insert the soup header and the article in the MSG buf.
+ (set-buffer msg-buf)
+ (goto-char (point-max))
+ (insert head-line)
+ (setq beg (point))
+ (insert-buffer-substring article-buf)
+ ;; Insert the index in the IDX buf.
+ (cond ((= index ?c)
+ (set-buffer idx-buf)
+ (gnus-soup-insert-idx beg headers))
+ ((/= index ?n)
+ (error "Unknown index type: %c" type)))
+ ;; Return the MSG buf.
+ msg-buf)))
+
+(defun gnus-soup-group-brew (group &optional not-all)
+ "Enter GROUP and add all articles to a SOUP package.
+If NOT-ALL, don't pack ticked articles."
+ (let ((gnus-expert-user t)
+ (gnus-large-newsgroup nil)
+ (entry (gnus-gethash group gnus-newsrc-hashtb)))
+ (when (or (null entry)
+ (eq (car entry) t)
+ (and (car entry)
+ (> (car entry) 0))
+ (and (not not-all)
+ (gnus-range-length (cdr (assq 'tick (gnus-info-marks
+ (nth 2 entry)))))))
+ (when (gnus-summary-read-group group nil t)
+ (setq gnus-newsgroup-processable
+ (reverse
+ (if (not not-all)
+ (append gnus-newsgroup-marked gnus-newsgroup-unreads)
+ gnus-newsgroup-unreads)))
+ (gnus-soup-add-article nil)
+ (gnus-summary-exit)))))
+
+(defun gnus-soup-insert-idx (offset header)
+ ;; [number subject from date id references chars lines xref]
+ (goto-char (point-max))
+ (insert
+ (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n"
+ offset
+ (or (mail-header-subject header) "(none)")
+ (or (mail-header-from header) "(nobody)")
+ (or (mail-header-date header) "")
+ (or (mail-header-id header)
+ (concat "soup-dummy-id-"
+ (mapconcat
+ (lambda (time) (int-to-string time))
+ (current-time) "-")))
+ (or (mail-header-references header) "")
+ (or (mail-header-chars header) 0)
+ (or (mail-header-lines header) "0"))))
+
+(defun gnus-soup-save-areas ()
+ (gnus-soup-write-areas)
+ (save-excursion
+ (let (buf)
+ (while gnus-soup-buffers
+ (setq buf (car gnus-soup-buffers)
+ gnus-soup-buffers (cdr gnus-soup-buffers))
+ (if (not (buffer-name buf))
+ ()
+ (set-buffer buf)
+ (when (buffer-modified-p)
+ (save-buffer))
+ (kill-buffer (current-buffer)))))
+ (gnus-soup-write-prefixes)))
+
+(defun gnus-soup-write-prefixes ()
+ (let ((prefixes gnus-soup-last-prefix)
+ prefix)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (while (setq prefix (pop prefixes))
+ (erase-buffer)
+ (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))
+ (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file))))))
+
+(defun gnus-soup-pack (dir packer)
+ (let* ((files (mapconcat 'identity
+ '("AREAS" "*.MSG" "*.IDX" "INFO"
+ "LIST" "REPLIES" "COMMANDS" "ERRORS")
+ " "))
+ (packer (if (< (string-match "%s" packer)
+ (string-match "%d" packer))
+ (format packer files
+ (string-to-int (gnus-soup-unique-prefix dir)))
+ (format packer
+ (string-to-int (gnus-soup-unique-prefix dir))
+ files)))
+ (dir (expand-file-name dir)))
+ (gnus-make-directory dir)
+ (setq gnus-soup-areas nil)
+ (gnus-message 4 "Packing %s..." packer)
+ (if (zerop (call-process shell-file-name
+ nil nil nil shell-command-switch
+ (concat "cd " dir " ; " packer)))
+ (progn
+ (call-process shell-file-name nil nil nil shell-command-switch
+ (concat "cd " dir " ; rm " files))
+ (gnus-message 4 "Packing...done" packer))
+ (error "Couldn't pack packet"))))
+
+(defun gnus-soup-parse-areas (file)
+ "Parse soup area file FILE.
+The result is a of vectors, each containing one entry from the AREA file.
+The vector contain five strings,
+ [prefix name encoding description number]
+though the two last may be nil if they are missing."
+ (let (areas)
+ (save-excursion
+ (set-buffer (nnheader-find-file-noselect file 'force))
+ (buffer-disable-undo (current-buffer))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (push (vector (gnus-soup-field)
+ (gnus-soup-field)
+ (gnus-soup-field)
+ (and (eq (preceding-char) ?\t)
+ (gnus-soup-field))
+ (and (eq (preceding-char) ?\t)
+ (string-to-int (gnus-soup-field))))
+ areas)
+ (when (eq (preceding-char) ?\t)
+ (beginning-of-line 2)))
+ (kill-buffer (current-buffer)))
+ areas))
+
+(defun gnus-soup-parse-replies (file)
+ "Parse soup REPLIES file FILE.
+The result is a of vectors, each containing one entry from the REPLIES
+file. The vector contain three strings, [prefix name encoding]."
+ (let (replies)
+ (save-excursion
+ (set-buffer (nnheader-find-file-noselect file))
+ (buffer-disable-undo (current-buffer))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (push (vector (gnus-soup-field) (gnus-soup-field)
+ (gnus-soup-field))
+ replies)
+ (when (eq (preceding-char) ?\t)
+ (beginning-of-line 2)))
+ (kill-buffer (current-buffer)))
+ replies))
+
+(defun gnus-soup-field ()
+ (prog1
+ (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point)))
+ (forward-char 1)))
+
+(defun gnus-soup-read-areas ()
+ (or gnus-soup-areas
+ (setq gnus-soup-areas
+ (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS")))))
+
+(defun gnus-soup-write-areas ()
+ "Write the AREAS file."
+ (interactive)
+ (when gnus-soup-areas
+ (nnheader-temp-write (concat gnus-soup-directory "AREAS")
+ (let ((areas gnus-soup-areas)
+ area)
+ (while (setq area (pop areas))
+ (insert
+ (format
+ "%s\t%s\t%s%s\n"
+ (gnus-soup-area-prefix area)
+ (gnus-soup-area-name area)
+ (gnus-soup-area-encoding area)
+ (if (or (gnus-soup-area-description area)
+ (gnus-soup-area-number area))
+ (concat "\t" (or (gnus-soup-area-description
+ area) "")
+ (if (gnus-soup-area-number area)
+ (concat "\t" (int-to-string
+ (gnus-soup-area-number area)))
+ "")) ""))))))))
+
+(defun gnus-soup-write-replies (dir areas)
+ "Write a REPLIES file in DIR containing AREAS."
+ (nnheader-temp-write (concat dir "REPLIES")
+ (let (area)
+ (while (setq area (pop areas))
+ (insert (format "%s\t%s\t%s\n"
+ (gnus-soup-reply-prefix area)
+ (gnus-soup-reply-kind area)
+ (gnus-soup-reply-encoding area)))))))
+
+(defun gnus-soup-area (group)
+ (gnus-soup-read-areas)
+ (let ((areas gnus-soup-areas)
+ (real-group (gnus-group-real-name group))
+ area result)
+ (while areas
+ (setq area (car areas)
+ areas (cdr areas))
+ (when (equal (gnus-soup-area-name area) real-group)
+ (setq result area)))
+ (unless result
+ (setq result
+ (vector (gnus-soup-unique-prefix)
+ real-group
+ (format "%c%c%c"
+ gnus-soup-encoding-type
+ gnus-soup-index-type
+ (if (gnus-member-of-valid 'mail group) ?m ?n))
+ nil nil)
+ gnus-soup-areas (cons result gnus-soup-areas)))
+ result))
+
+(defun gnus-soup-unique-prefix (&optional dir)
+ (let* ((dir (file-name-as-directory (or dir gnus-soup-directory)))
+ (entry (assoc dir gnus-soup-last-prefix))
+ gnus-soup-prev-prefix)
+ (if entry
+ ()
+ (when (file-exists-p (concat dir gnus-soup-prefix-file))
+ (ignore-errors
+ (load (concat dir gnus-soup-prefix-file) nil t t)))
+ (push (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
+ gnus-soup-last-prefix))
+ (setcdr entry (1+ (cdr entry)))
+ (gnus-soup-write-prefixes)
+ (int-to-string (cdr entry))))
+
+(defun gnus-soup-unpack-packet (dir unpacker packet)
+ "Unpack PACKET into DIR using UNPACKER.
+Return whether the unpacking was successful."
+ (gnus-make-directory dir)
+ (gnus-message 4 "Unpacking: %s" (format unpacker packet))
+ (prog1
+ (zerop (call-process
+ shell-file-name nil nil nil shell-command-switch
+ (format "cd %s ; %s" (expand-file-name dir)
+ (format unpacker packet))))
+ (gnus-message 4 "Unpacking...done")))
+
+(defun gnus-soup-send-packet (packet)
+ (gnus-soup-unpack-packet
+ gnus-soup-replies-directory gnus-soup-unpacker packet)
+ (let ((replies (gnus-soup-parse-replies
+ (concat gnus-soup-replies-directory "REPLIES"))))
+ (save-excursion
+ (while replies
+ (let* ((msg-file (concat gnus-soup-replies-directory
+ (gnus-soup-reply-prefix (car replies))
+ ".MSG"))
+ (msg-buf (and (file-exists-p msg-file)
+ (nnheader-find-file-noselect msg-file)))
+ (tmp-buf (get-buffer-create " *soup send*"))
+ beg end)
+ (cond
+ ((/= (gnus-soup-encoding-format
+ (gnus-soup-reply-encoding (car replies)))
+ ?n)
+ (error "Unsupported encoding"))
+ ((null msg-buf)
+ t)
+ (t
+ (buffer-disable-undo msg-buf)
+ (buffer-disable-undo tmp-buf)
+ (set-buffer msg-buf)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (looking-at "#! *rnews +\\([0-9]+\\)")
+ (error "Bad header"))
+ (forward-line 1)
+ (setq beg (point)
+ end (+ (point) (string-to-int
+ (buffer-substring
+ (match-beginning 1) (match-end 1)))))
+ (switch-to-buffer tmp-buf)
+ (erase-buffer)
+ (insert-buffer-substring msg-buf beg end)
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ (setq message-newsreader (setq message-mailer
+ (gnus-extended-version)))
+ (cond
+ ((string= (gnus-soup-reply-kind (car replies)) "news")
+ (gnus-message 5 "Sending news message to %s..."
+ (mail-fetch-field "newsgroups"))
+ (sit-for 1)
+ (let ((message-syntax-checks
+ 'dont-check-for-anything-just-trust-me))
+ (funcall message-send-news-function)))
+ ((string= (gnus-soup-reply-kind (car replies)) "mail")
+ (gnus-message 5 "Sending mail to %s..."
+ (mail-fetch-field "to"))
+ (sit-for 1)
+ (message-send-mail))
+ (t
+ (error "Unknown reply kind")))
+ (set-buffer msg-buf)
+ (goto-char end))
+ (delete-file (buffer-file-name))
+ (kill-buffer msg-buf)
+ (kill-buffer tmp-buf)
+ (gnus-message 4 "Sent packet"))))
+ (setq replies (cdr replies)))
+ t)))
+
+(provide 'gnus-soup)
+
+;;; gnus-soup.el ends here
--- /dev/null
+;;; gnus-spec.el --- format spec functions for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+
+;;; Internal variables.
+
+(defvar gnus-summary-mark-positions nil)
+(defvar gnus-group-mark-positions nil)
+(defvar gnus-group-indentation "")
+
+;; Format specs. The chunks below are the machine-generated forms
+;; that are to be evaled as the result of the default format strings.
+;; We write them in here to get them byte-compiled. That way the
+;; default actions will be quite fast, while still retaining the full
+;; flexibility of the user-defined format specs.
+
+;; First we have lots of dummy defvars to let the compiler know these
+;; are really dynamic variables.
+
+(defvar gnus-tmp-unread)
+(defvar gnus-tmp-replied)
+(defvar gnus-tmp-score-char)
+(defvar gnus-tmp-indentation)
+(defvar gnus-tmp-opening-bracket)
+(defvar gnus-tmp-lines)
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-closing-bracket)
+(defvar gnus-tmp-subject-or-nil)
+(defvar gnus-tmp-subject)
+(defvar gnus-tmp-marked)
+(defvar gnus-tmp-marked-mark)
+(defvar gnus-tmp-subscribed)
+(defvar gnus-tmp-process-marked)
+(defvar gnus-tmp-number-of-unread)
+(defvar gnus-tmp-group-name)
+(defvar gnus-tmp-group)
+(defvar gnus-tmp-article-number)
+(defvar gnus-tmp-unread-and-unselected)
+(defvar gnus-tmp-news-method)
+(defvar gnus-tmp-news-server)
+(defvar gnus-tmp-article-number)
+(defvar gnus-mouse-face)
+(defvar gnus-mouse-face-prop)
+
+(defun gnus-summary-line-format-spec ()
+ (insert gnus-tmp-unread gnus-tmp-replied
+ gnus-tmp-score-char gnus-tmp-indentation)
+ (gnus-put-text-property
+ (point)
+ (progn
+ (insert
+ gnus-tmp-opening-bracket
+ (format "%4d: %-20s"
+ gnus-tmp-lines
+ (if (> (length gnus-tmp-name) 20)
+ (substring gnus-tmp-name 0 20)
+ gnus-tmp-name))
+ gnus-tmp-closing-bracket)
+ (point))
+ gnus-mouse-face-prop gnus-mouse-face)
+ (insert " " gnus-tmp-subject-or-nil "\n"))
+
+(defvar gnus-summary-line-format-spec
+ (gnus-byte-code 'gnus-summary-line-format-spec))
+
+(defun gnus-summary-dummy-line-format-spec ()
+ (insert "* ")
+ (gnus-put-text-property
+ (point)
+ (progn
+ (insert ": :")
+ (point))
+ gnus-mouse-face-prop gnus-mouse-face)
+ (insert " " gnus-tmp-subject "\n"))
+
+(defvar gnus-summary-dummy-line-format-spec
+ (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
+
+(defun gnus-group-line-format-spec ()
+ (insert gnus-tmp-marked-mark gnus-tmp-subscribed
+ gnus-tmp-process-marked
+ gnus-group-indentation
+ (format "%5s: " gnus-tmp-number-of-unread))
+ (gnus-put-text-property
+ (point)
+ (progn
+ (insert gnus-tmp-group "\n")
+ (1- (point)))
+ gnus-mouse-face-prop gnus-mouse-face))
+(defvar gnus-group-line-format-spec
+ (gnus-byte-code 'gnus-group-line-format-spec))
+
+(defvar gnus-format-specs
+ `((version . ,emacs-version)
+ (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec)
+ (summary-dummy "* %(: :%) %S\n"
+ ,gnus-summary-dummy-line-format-spec)
+ (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ ,gnus-summary-line-format-spec))
+ "Alist of format specs.")
+
+(defvar gnus-article-mode-line-format-spec nil)
+(defvar gnus-summary-mode-line-format-spec nil)
+(defvar gnus-group-mode-line-format-spec nil)
+
+;;; Phew. All that gruft is over, fortunately.
+
+;;;###autoload
+(defun gnus-update-format (var)
+ "Update the format specification near point."
+ (interactive
+ (list
+ (save-excursion
+ (eval-defun nil)
+ ;; Find the end of the current word.
+ (re-search-forward "[ \t\n]" nil t)
+ ;; Search backward.
+ (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
+ (match-string 1)))))
+ (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
+ (match-string 1 var))))
+ (entry (assq type gnus-format-specs))
+ value spec)
+ (when entry
+ (setq gnus-format-specs (delq entry gnus-format-specs)))
+ (set
+ (intern (format "%s-spec" var))
+ (gnus-parse-format (setq value (symbol-value (intern var)))
+ (symbol-value (intern (format "%s-alist" var)))
+ (not (string-match "mode" var))))
+ (setq spec (symbol-value (intern (format "%s-spec" var))))
+ (push (list type value spec) gnus-format-specs)
+
+ (pop-to-buffer "*Gnus Format*")
+ (erase-buffer)
+ (lisp-interaction-mode)
+ (insert (pp-to-string spec))))
+
+(defun gnus-update-format-specifications (&optional force &rest types)
+ "Update all (necessary) format specifications."
+ ;; Make the indentation array.
+ ;; See whether all the stored info needs to be flushed.
+ (when (or force
+ (not (equal emacs-version
+ (cdr (assq 'version gnus-format-specs)))))
+ (setq gnus-format-specs nil))
+
+ ;; Go through all the formats and see whether they need updating.
+ (let (new-format entry type val)
+ (while (setq type (pop types))
+ ;; Jump to the proper buffer to find out the value of
+ ;; the variable, if possible. (It may be buffer-local.)
+ (save-excursion
+ (let ((buffer (intern (format "gnus-%s-buffer" type)))
+ val)
+ (when (and (boundp buffer)
+ (setq val (symbol-value buffer))
+ (get-buffer val)
+ (buffer-name (get-buffer val)))
+ (set-buffer (get-buffer val)))
+ (setq new-format (symbol-value
+ (intern (format "gnus-%s-line-format" type)))))
+ (setq entry (cdr (assq type gnus-format-specs)))
+ (if (and (car entry)
+ (equal (car entry) new-format))
+ ;; Use the old format.
+ (set (intern (format "gnus-%s-line-format-spec" type))
+ (cadr entry))
+ ;; This is a new format.
+ (setq val
+ (if (not (stringp new-format))
+ ;; This is a function call or something.
+ new-format
+ ;; This is a "real" format.
+ (gnus-parse-format
+ new-format
+ (symbol-value
+ (intern (format "gnus-%s-line-format-alist"
+ (if (eq type 'article-mode)
+ 'summary-mode type))))
+ (not (string-match "mode$" (symbol-name type))))))
+ ;; Enter the new format spec into the list.
+ (if entry
+ (progn
+ (setcar (cdr entry) val)
+ (setcar entry new-format))
+ (push (list type new-format val) gnus-format-specs))
+ (set (intern (format "gnus-%s-line-format-spec" type)) val)))))
+
+ (unless (assq 'version gnus-format-specs)
+ (push (cons 'version emacs-version) gnus-format-specs)))
+
+(defvar gnus-mouse-face-0 'highlight)
+(defvar gnus-mouse-face-1 'highlight)
+(defvar gnus-mouse-face-2 'highlight)
+(defvar gnus-mouse-face-3 'highlight)
+(defvar gnus-mouse-face-4 'highlight)
+
+(defun gnus-mouse-face-function (form type)
+ `(gnus-put-text-property
+ (point) (progn ,@form (point))
+ gnus-mouse-face-prop
+ ,(if (equal type 0)
+ 'gnus-mouse-face
+ `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
+
+(defvar gnus-face-0 'bold)
+(defvar gnus-face-1 'italic)
+(defvar gnus-face-2 'bold-italic)
+(defvar gnus-face-3 'bold)
+(defvar gnus-face-4 'bold)
+
+(defun gnus-face-face-function (form type)
+ `(gnus-put-text-property
+ (point) (progn ,@form (point))
+ 'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
+
+(defun gnus-tilde-max-form (el max-width)
+ "Return a form that limits EL to MAX-WIDTH."
+ (let ((max (abs max-width)))
+ (if (symbolp el)
+ `(if (> (length ,el) ,max)
+ ,(if (< max-width 0)
+ `(substring ,el (- (length el) ,max))
+ `(substring ,el 0 ,max))
+ ,el)
+ `(let ((val (eval ,el)))
+ (if (> (length val) ,max)
+ ,(if (< max-width 0)
+ `(substring val (- (length val) ,max))
+ `(substring val 0 ,max))
+ val)))))
+
+(defun gnus-tilde-cut-form (el cut-width)
+ "Return a form that cuts CUT-WIDTH off of EL."
+ (let ((cut (abs cut-width)))
+ (if (symbolp el)
+ `(if (> (length ,el) ,cut)
+ ,(if (< cut-width 0)
+ `(substring ,el 0 (- (length el) ,cut))
+ `(substring ,el ,cut))
+ ,el)
+ `(let ((val (eval ,el)))
+ (if (> (length val) ,cut)
+ ,(if (< cut-width 0)
+ `(substring val 0 (- (length val) ,cut))
+ `(substring val ,cut))
+ val)))))
+
+(defun gnus-tilde-ignore-form (el ignore-value)
+ "Return a form that is blank when EL is IGNORE-VALUE."
+ (if (symbolp el)
+ `(if (equal ,el ,ignore-value)
+ "" ,el)
+ `(let ((val (eval ,el)))
+ (if (equal val ,ignore-value)
+ "" val))))
+
+(defun gnus-parse-format (format spec-alist &optional insert)
+ ;; This function parses the FORMAT string with the help of the
+ ;; SPEC-ALIST and returns a list that can be eval'ed to return the
+ ;; string. If the FORMAT string contains the specifiers %( and %)
+ ;; the text between them will have the mouse-face text property.
+ (if (string-match
+ "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
+ format)
+ (gnus-parse-complex-format format spec-alist)
+ ;; This is a simple format.
+ (gnus-parse-simple-format format spec-alist insert)))
+
+(defun gnus-parse-complex-format (format spec-alist)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert format)
+ (goto-char (point-min))
+ (while (re-search-forward "\"" nil t)
+ (replace-match "\\\"" nil t))
+ (goto-char (point-min))
+ (insert "(\"")
+ (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
+ (let ((number (if (match-beginning 1)
+ (match-string 1) "0"))
+ (delim (aref (match-string 2) 0)))
+ (if (or (= delim ?\() (= delim ?\{))
+ (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
+ " " number " \""))
+ (replace-match "\")\""))))
+ (goto-char (point-max))
+ (insert "\")")
+ (goto-char (point-min))
+ (let ((form (read (current-buffer))))
+ (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
+
+(defun gnus-complex-form-to-spec (form spec-alist)
+ (delq nil
+ (mapcar
+ (lambda (sform)
+ (if (stringp sform)
+ (gnus-parse-simple-format sform spec-alist t)
+ (funcall (intern (format "gnus-%s-face-function" (car sform)))
+ (gnus-complex-form-to-spec (cddr sform) spec-alist)
+ (nth 1 sform))))
+ form)))
+
+(defun gnus-parse-simple-format (format spec-alist &optional insert)
+ ;; This function parses the FORMAT string with the help of the
+ ;; SPEC-ALIST and returns a list that can be eval'ed to return a
+ ;; string.
+ (let ((max-width 0)
+ spec flist fstring elem result dontinsert user-defined
+ type value pad-width spec-beg cut-width ignore-value
+ tilde-form tilde elem-type)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert format)
+ (goto-char (point-min))
+ (while (re-search-forward "%" nil t)
+ (setq user-defined nil
+ spec-beg nil
+ pad-width nil
+ max-width nil
+ cut-width nil
+ ignore-value nil
+ tilde-form nil)
+ (setq spec-beg (1- (point)))
+
+ ;; Parse this spec fully.
+ (while
+ (cond
+ ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?")
+ (setq pad-width (string-to-number (match-string 1)))
+ (when (match-beginning 2)
+ (setq max-width (string-to-number (buffer-substring
+ (1+ (match-beginning 2))
+ (match-end 2)))))
+ (goto-char (match-end 0)))
+ ((looking-at "~")
+ (forward-char 1)
+ (setq tilde (read (current-buffer))
+ type (car tilde)
+ value (cadr tilde))
+ (cond
+ ((memq type '(pad pad-left))
+ (setq pad-width value))
+ ((eq type 'pad-right)
+ (setq pad-width (- value)))
+ ((memq type '(max-right max))
+ (setq max-width value))
+ ((eq type 'max-left)
+ (setq max-width (- value)))
+ ((memq type '(cut cut-left))
+ (setq cut-width value))
+ ((eq type 'cut-right)
+ (setq cut-width (- value)))
+ ((eq type 'ignore)
+ (setq ignore-value
+ (if (stringp value) value (format "%s" value))))
+ ((eq type 'form)
+ (setq tilde-form value))
+ (t
+ (error "Unknown tilde type: %s" tilde)))
+ t)
+ (t
+ nil)))
+ ;; User-defined spec -- find the spec name.
+ (when (= (setq spec (following-char)) ?u)
+ (forward-char 1)
+ (setq user-defined (following-char)))
+ (forward-char 1)
+ (delete-region spec-beg (point))
+
+ ;; Now we have all the relevant data on this spec, so
+ ;; we start doing stuff.
+ (insert "%")
+ (if (eq spec ?%)
+ ;; "%%" just results in a "%".
+ (insert "%")
+ (cond
+ ;; Do tilde forms.
+ ((eq spec ?@)
+ (setq elem (list tilde-form ?s)))
+ ;; Treat user defined format specifiers specially.
+ (user-defined
+ (setq elem
+ (list
+ (list (intern (format "gnus-user-format-function-%c"
+ user-defined))
+ 'gnus-tmp-header)
+ ?s)))
+ ;; Find the specification from `spec-alist'.
+ ((setq elem (cdr (assq spec spec-alist))))
+ (t
+ (setq elem '("*" ?s))))
+ (setq elem-type (cadr elem))
+ ;; Insert the new format elements.
+ (when pad-width
+ (insert (number-to-string pad-width)))
+ ;; Create the form to be evaled.
+ (if (or max-width cut-width ignore-value)
+ (progn
+ (insert ?s)
+ (let ((el (car elem)))
+ (cond ((= (cadr elem) ?c)
+ (setq el (list 'char-to-string el)))
+ ((= (cadr elem) ?d)
+ (setq el (list 'int-to-string el))))
+ (when ignore-value
+ (setq el (gnus-tilde-ignore-form el ignore-value)))
+ (when cut-width
+ (setq el (gnus-tilde-cut-form el cut-width)))
+ (when max-width
+ (setq el (gnus-tilde-max-form el max-width)))
+ (push el flist)))
+ (insert elem-type)
+ (push (car elem) flist))))
+ (setq fstring (buffer-string)))
+
+ ;; Do some postprocessing to increase efficiency.
+ (setq
+ result
+ (cond
+ ;; Emptyness.
+ ((string= fstring "")
+ nil)
+ ;; Not a format string.
+ ((not (string-match "%" fstring))
+ (list fstring))
+ ;; A format string with just a single string spec.
+ ((string= fstring "%s")
+ (list (car flist)))
+ ;; A single character.
+ ((string= fstring "%c")
+ (list (car flist)))
+ ;; A single number.
+ ((string= fstring "%d")
+ (setq dontinsert)
+ (if insert
+ (list `(princ ,(car flist)))
+ (list `(int-to-string ,(car flist)))))
+ ;; Just lots of chars and strings.
+ ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
+ (nreverse flist))
+ ;; A single string spec at the beginning of the spec.
+ ((string-match "\\`%[sc][^%]+\\'" fstring)
+ (list (car flist) (substring fstring 2)))
+ ;; A single string spec in the middle of the spec.
+ ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
+ (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
+ ;; A single string spec in the end of the spec.
+ ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
+ (list (match-string 1 fstring) (car flist)))
+ ;; A more complex spec.
+ (t
+ (list (cons 'format (cons fstring (nreverse flist)))))))
+
+ (if insert
+ (when result
+ (if dontinsert
+ result
+ (cons 'insert result)))
+ (cond ((stringp result)
+ result)
+ ((consp result)
+ (cons 'concat result))
+ (t "")))))
+
+(defun gnus-eval-format (format &optional alist props)
+ "Eval the format variable FORMAT, using ALIST.
+If PROPS, insert the result."
+ (let ((form (gnus-parse-format format alist props)))
+ (if props
+ (gnus-add-text-properties (point) (progn (eval form) (point)) props)
+ (eval form))))
+
+(defun gnus-compile ()
+ "Byte-compile the user-defined format specs."
+ (interactive)
+ (when gnus-xemacs
+ (error "Can't compile specs under XEmacs"))
+ (let ((entries gnus-format-specs)
+ (byte-compile-warnings '(unresolved callargs redefine))
+ entry gnus-tmp-func)
+ (save-excursion
+ (gnus-message 7 "Compiling format specs...")
+
+ (while entries
+ (setq entry (pop entries))
+ (if (eq (car entry) 'version)
+ (setq gnus-format-specs (delq entry gnus-format-specs))
+ (when (and (listp (caddr entry))
+ (not (eq 'byte-code (caaddr entry))))
+ (fset 'gnus-tmp-func `(lambda () ,(caddr entry)))
+ (byte-compile 'gnus-tmp-func)
+ (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
+
+ (push (cons 'version emacs-version) gnus-format-specs)
+ ;; Mark the .newsrc.eld file as "dirty".
+ (gnus-dribble-enter " ")
+ (gnus-message 7 "Compiling user specs...done"))))
+
+(defun gnus-set-format (type &optional insertable)
+ (set (intern (format "gnus-%s-line-format-spec" type))
+ (gnus-parse-format
+ (symbol-value (intern (format "gnus-%s-line-format" type)))
+ (symbol-value (intern (format "gnus-%s-line-format-alist" type)))
+ insertable)))
+
+
+(provide 'gnus-spec)
+
+;;; gnus-spec.el ends here
--- /dev/null
+;;; gnus-srvr.el --- virtual server support for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-spec)
+(require 'gnus-group)
+(require 'gnus-int)
+(require 'gnus-range)
+
+(defvar gnus-server-mode-hook nil
+ "Hook run in `gnus-server-mode' buffers.")
+
+(defconst gnus-server-line-format " {%(%h:%w%)} %s\n"
+ "Format of server lines.
+It works along the same lines as a normal formatting string,
+with some simple extensions.
+
+The following specs are understood:
+
+%h backend
+%n name
+%w address
+%s status")
+
+(defvar gnus-server-mode-line-format "Gnus: %%b"
+ "The format specification for the server mode line.")
+
+(defvar gnus-server-exit-hook nil
+ "*Hook run when exiting the server buffer.")
+
+;;; Internal variables.
+
+(defvar gnus-inserted-opened-servers nil)
+
+(defvar gnus-server-line-format-alist
+ `((?h how ?s)
+ (?n name ?s)
+ (?w where ?s)
+ (?s status ?s)))
+
+(defvar gnus-server-mode-line-format-alist
+ `((?S news-server ?s)
+ (?M news-method ?s)
+ (?u user-defined ?s)))
+
+(defvar gnus-server-line-format-spec nil)
+(defvar gnus-server-mode-line-format-spec nil)
+(defvar gnus-server-killed-servers nil)
+
+(defvar gnus-server-mode-map)
+
+(defvar gnus-server-menu-hook nil
+ "*Hook run after the creation of the server mode menu.")
+
+(defun gnus-server-make-menu-bar ()
+ (gnus-turn-off-edit-menu 'server)
+ (unless (boundp 'gnus-server-server-menu)
+ (easy-menu-define
+ gnus-server-server-menu gnus-server-mode-map ""
+ '("Server"
+ ["Add" gnus-server-add-server t]
+ ["Browse" gnus-server-read-server t]
+ ["Scan" gnus-server-scan-server t]
+ ["List" gnus-server-list-servers t]
+ ["Kill" gnus-server-kill-server t]
+ ["Yank" gnus-server-yank-server t]
+ ["Copy" gnus-server-copy-server t]
+ ["Edit" gnus-server-edit-server t]
+ ["Regenerate" gnus-server-regenerate-server t]
+ ["Exit" gnus-server-exit t]))
+
+ (easy-menu-define
+ gnus-server-connections-menu gnus-server-mode-map ""
+ '("Connections"
+ ["Open" gnus-server-open-server t]
+ ["Close" gnus-server-close-server t]
+ ["Deny" gnus-server-deny-server t]
+ "---"
+ ["Open All" gnus-server-open-all-servers t]
+ ["Close All" gnus-server-close-all-servers t]
+ ["Reset All" gnus-server-remove-denials t]))
+
+ (run-hooks 'gnus-server-menu-hook)))
+
+(defvar gnus-server-mode-map nil)
+(put 'gnus-server-mode 'mode-class 'special)
+
+(unless gnus-server-mode-map
+ (setq gnus-server-mode-map (make-sparse-keymap))
+ (suppress-keymap gnus-server-mode-map)
+
+ (gnus-define-keys gnus-server-mode-map
+ " " gnus-server-read-server
+ "\r" gnus-server-read-server
+ gnus-mouse-2 gnus-server-pick-server
+ "q" gnus-server-exit
+ "l" gnus-server-list-servers
+ "k" gnus-server-kill-server
+ "y" gnus-server-yank-server
+ "c" gnus-server-copy-server
+ "a" gnus-server-add-server
+ "e" gnus-server-edit-server
+ "s" gnus-server-scan-server
+
+ "O" gnus-server-open-server
+ "\M-o" gnus-server-open-all-servers
+ "C" gnus-server-close-server
+ "\M-c" gnus-server-close-all-servers
+ "D" gnus-server-deny-server
+ "R" gnus-server-remove-denials
+
+ "g" gnus-server-regenerate-server
+
+ "\C-c\C-i" gnus-info-find-node
+ "\C-c\C-b" gnus-bug))
+
+(defun gnus-server-mode ()
+ "Major mode for listing and editing servers.
+
+All normal editing commands are switched off.
+\\<gnus-server-mode-map>
+For more in-depth information on this mode, read the manual
+(`\\[gnus-info-find-node]').
+
+The following commands are available:
+
+\\{gnus-server-mode-map}"
+ (interactive)
+ (when (gnus-visual-p 'server-menu 'menu)
+ (gnus-server-make-menu-bar))
+ (kill-all-local-variables)
+ (gnus-simplify-mode-line)
+ (setq major-mode 'gnus-server-mode)
+ (setq mode-name "Server")
+ (gnus-set-default-directory)
+ (setq mode-line-process nil)
+ (use-local-map gnus-server-mode-map)
+ (buffer-disable-undo (current-buffer))
+ (setq truncate-lines t)
+ (setq buffer-read-only t)
+ (run-hooks 'gnus-server-mode-hook))
+
+(defun gnus-server-insert-server-line (name method)
+ (let* ((how (car method))
+ (where (nth 1 method))
+ (elem (assoc method gnus-opened-servers))
+ (status (cond ((eq (nth 1 elem) 'denied)
+ "(denied)")
+ ((or (gnus-server-opened method)
+ (eq (nth 1 elem) 'ok))
+ "(opened)")
+ (t
+ "(closed)"))))
+ (beginning-of-line)
+ (gnus-add-text-properties
+ (point)
+ (prog1 (1+ (point))
+ ;; Insert the text.
+ (eval gnus-server-line-format-spec))
+ (list 'gnus-server (intern name)))))
+
+(defun gnus-enter-server-buffer ()
+ "Set up the server buffer."
+ (gnus-server-setup-buffer)
+ (gnus-configure-windows 'server)
+ (gnus-server-prepare))
+
+(defun gnus-server-setup-buffer ()
+ "Initialize the server buffer."
+ (unless (get-buffer gnus-server-buffer)
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-server-buffer))
+ (gnus-server-mode)
+ (when gnus-carpal
+ (gnus-carpal-setup-buffer 'server)))))
+
+(defun gnus-server-prepare ()
+ (gnus-set-format 'server-mode)
+ (gnus-set-format 'server t)
+ (let ((alist gnus-server-alist)
+ (buffer-read-only nil)
+ (opened gnus-opened-servers)
+ done server op-ser)
+ (erase-buffer)
+ (setq gnus-inserted-opened-servers nil)
+ ;; First we do the real list of servers.
+ (while alist
+ (unless (member (cdar alist) done)
+ (push (cdar alist) done)
+ (cdr (setq server (pop alist)))
+ (when (and server (car server) (cdr server))
+ (gnus-server-insert-server-line (car server) (cdr server))))
+ (when (member (cdar alist) done)
+ (pop alist)))
+ ;; Then we insert the list of servers that have been opened in
+ ;; this session.
+ (while opened
+ (unless (member (caar opened) done)
+ (push (caar opened) done)
+ (gnus-server-insert-server-line
+ (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
+ (caar opened))
+ (push (list op-ser (caar opened)) gnus-inserted-opened-servers))
+ (setq opened (cdr opened))))
+ (goto-char (point-min))
+ (gnus-server-position-point))
+
+(defun gnus-server-server-name ()
+ (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server)))
+ (and server (symbol-name server))))
+
+(defalias 'gnus-server-position-point 'gnus-goto-colon)
+
+(defconst gnus-server-edit-buffer "*Gnus edit server*")
+
+(defun gnus-server-update-server (server)
+ (save-excursion
+ (set-buffer gnus-server-buffer)
+ (let* ((buffer-read-only nil)
+ (entry (assoc server gnus-server-alist))
+ (oentry (assoc (gnus-server-to-method server)
+ gnus-opened-servers)))
+ (when entry
+ (gnus-dribble-enter
+ (concat "(gnus-server-set-info \"" server "\" '"
+ (prin1-to-string (cdr entry)) ")\n")))
+ (when (or entry oentry)
+ ;; Buffer may be narrowed.
+ (save-restriction
+ (widen)
+ (when (gnus-server-goto-server server)
+ (gnus-delete-line))
+ (if entry
+ (gnus-server-insert-server-line (car entry) (cdr entry))
+ (gnus-server-insert-server-line
+ (format "%s:%s" (caar oentry) (nth 1 (car oentry)))
+ (car oentry)))
+ (gnus-server-position-point))))))
+
+(defun gnus-server-set-info (server info)
+ ;; Enter a select method into the virtual server alist.
+ (when (and server info)
+ (gnus-dribble-enter
+ (concat "(gnus-server-set-info \"" server "\" '"
+ (prin1-to-string info) ")"))
+ (let* ((server (nth 1 info))
+ (entry (assoc server gnus-server-alist)))
+ (if entry (setcdr entry info)
+ (setq gnus-server-alist
+ (nconc gnus-server-alist (list (cons server info))))))))
+
+;;; Interactive server functions.
+
+(defun gnus-server-kill-server (server)
+ "Kill the server on the current line."
+ (interactive (list (gnus-server-server-name)))
+ (unless (gnus-server-goto-server server)
+ (if server (error "No such server: %s" server)
+ (error "No server on the current line")))
+ (unless (assoc server gnus-server-alist)
+ (error "Read-only server %s" server))
+ (gnus-dribble-enter "")
+ (let ((buffer-read-only nil))
+ (gnus-delete-line))
+ (push (assoc server gnus-server-alist) gnus-server-killed-servers)
+ (setq gnus-server-alist (delq (car gnus-server-killed-servers)
+ gnus-server-alist))
+ (gnus-server-position-point))
+
+(defun gnus-server-yank-server ()
+ "Yank the previously killed server."
+ (interactive)
+ (unless gnus-server-killed-servers
+ (error "No killed servers to be yanked"))
+ (let ((alist gnus-server-alist)
+ (server (gnus-server-server-name))
+ (killed (car gnus-server-killed-servers)))
+ (if (not server)
+ (setq gnus-server-alist (nconc gnus-server-alist (list killed)))
+ (if (string= server (caar gnus-server-alist))
+ (push killed gnus-server-alist)
+ (while (and (cdr alist)
+ (not (string= server (caadr alist))))
+ (setq alist (cdr alist)))
+ (if alist
+ (setcdr alist (cons killed (cdr alist)))
+ (setq gnus-server-alist (list killed)))))
+ (gnus-server-update-server (car killed))
+ (setq gnus-server-killed-servers (cdr gnus-server-killed-servers))
+ (gnus-server-position-point)))
+
+(defun gnus-server-exit ()
+ "Return to the group buffer."
+ (interactive)
+ (run-hooks 'gnus-server-exit-hook)
+ (kill-buffer (current-buffer))
+ (gnus-configure-windows 'group t))
+
+(defun gnus-server-list-servers ()
+ "List all available servers."
+ (interactive)
+ (let ((cur (gnus-server-server-name)))
+ (gnus-server-prepare)
+ (if cur (gnus-server-goto-server cur)
+ (goto-char (point-max))
+ (forward-line -1))
+ (gnus-server-position-point)))
+
+(defun gnus-server-set-status (method status)
+ "Make METHOD have STATUS."
+ (let ((entry (assoc method gnus-opened-servers)))
+ (if entry
+ (setcar (cdr entry) status)
+ (push (list method status) gnus-opened-servers))))
+
+(defun gnus-opened-servers-remove (method)
+ "Remove METHOD from the list of opened servers."
+ (setq gnus-opened-servers (delq (assoc method gnus-opened-servers)
+ gnus-opened-servers)))
+
+(defun gnus-server-open-server (server)
+ "Force an open of SERVER."
+ (interactive (list (gnus-server-server-name)))
+ (let ((method (gnus-server-to-method server)))
+ (unless method
+ (error "No such server: %s" server))
+ (gnus-server-set-status method 'ok)
+ (prog1
+ (or (gnus-open-server method)
+ (progn (message "Couldn't open %s" server) nil))
+ (gnus-server-update-server server)
+ (gnus-server-position-point))))
+
+(defun gnus-server-open-all-servers ()
+ "Open all servers."
+ (interactive)
+ (let ((servers gnus-inserted-opened-servers))
+ (while servers
+ (gnus-server-open-server (car (pop servers))))))
+
+(defun gnus-server-close-server (server)
+ "Close SERVER."
+ (interactive (list (gnus-server-server-name)))
+ (let ((method (gnus-server-to-method server)))
+ (unless method
+ (error "No such server: %s" server))
+ (gnus-server-set-status method 'closed)
+ (prog1
+ (gnus-close-server method)
+ (gnus-server-update-server server)
+ (gnus-server-position-point))))
+
+(defun gnus-server-close-all-servers ()
+ "Close all servers."
+ (interactive)
+ (let ((servers gnus-inserted-opened-servers))
+ (while servers
+ (gnus-server-close-server (car (pop servers))))))
+
+(defun gnus-server-deny-server (server)
+ "Make sure SERVER will never be attempted opened."
+ (interactive (list (gnus-server-server-name)))
+ (let ((method (gnus-server-to-method server)))
+ (unless method
+ (error "No such server: %s" server))
+ (gnus-server-set-status method 'denied))
+ (gnus-server-update-server server)
+ (gnus-server-position-point)
+ t)
+
+(defun gnus-server-remove-denials ()
+ "Make all denied servers into closed servers."
+ (interactive)
+ (let ((servers gnus-opened-servers))
+ (while servers
+ (when (eq (nth 1 (car servers)) 'denied)
+ (setcar (nthcdr 1 (car servers)) 'closed))
+ (setq servers (cdr servers))))
+ (gnus-server-list-servers))
+
+(defun gnus-server-copy-server (from to)
+ (interactive
+ (list
+ (or (gnus-server-server-name)
+ (error "No server on the current line"))
+ (read-string "Copy to: ")))
+ (unless from
+ (error "No server on current line"))
+ (unless (and to (not (string= to "")))
+ (error "No name to copy to"))
+ (when (assoc to gnus-server-alist)
+ (error "%s already exists" to))
+ (unless (gnus-server-to-method from)
+ (error "%s: no such server" from))
+ (let ((to-entry (cons from (gnus-copy-sequence
+ (gnus-server-to-method from)))))
+ (setcar to-entry to)
+ (setcar (nthcdr 2 to-entry) to)
+ (push to-entry gnus-server-killed-servers)
+ (gnus-server-yank-server)))
+
+(defun gnus-server-add-server (how where)
+ (interactive
+ (list (intern (completing-read "Server method: "
+ gnus-valid-select-methods nil t))
+ (read-string "Server name: ")))
+ (when (assq where gnus-server-alist)
+ (error "Server with that name already defined"))
+ (push (list where how where) gnus-server-killed-servers)
+ (gnus-server-yank-server))
+
+(defun gnus-server-goto-server (server)
+ "Jump to a server line."
+ (interactive
+ (list (completing-read "Goto server: " gnus-server-alist nil t)))
+ (let ((to (text-property-any (point-min) (point-max)
+ 'gnus-server (intern server))))
+ (when to
+ (goto-char to)
+ (gnus-server-position-point))))
+
+(defun gnus-server-edit-server (server)
+ "Edit the server on the current line."
+ (interactive (list (gnus-server-server-name)))
+ (unless server
+ (error "No server on current line"))
+ (unless (assoc server gnus-server-alist)
+ (error "This server can't be edited"))
+ (let ((info (cdr (assoc server gnus-server-alist))))
+ (gnus-close-server info)
+ (gnus-edit-form
+ info "Editing the server."
+ `(lambda (form)
+ (gnus-server-set-info ,server form)
+ (gnus-server-list-servers)
+ (gnus-server-position-point)))))
+
+(defun gnus-server-scan-server (server)
+ "Request a scan from the current server."
+ (interactive (list (gnus-server-server-name)))
+ (gnus-message 3 "Scanning %s...done" server)
+ (gnus-request-scan nil (gnus-server-to-method server))
+ (gnus-message 3 "Scanning %s...done" server))
+
+(defun gnus-server-read-server (server)
+ "Browse a server."
+ (interactive (list (gnus-server-server-name)))
+ (let ((buf (current-buffer)))
+ (prog1
+ (gnus-browse-foreign-server (gnus-server-to-method server) buf)
+ (save-excursion
+ (set-buffer buf)
+ (gnus-server-update-server (gnus-server-server-name))
+ (gnus-server-position-point)))))
+
+(defun gnus-server-pick-server (e)
+ (interactive "e")
+ (mouse-set-point e)
+ (gnus-server-read-server (gnus-server-server-name)))
+
+\f
+;;;
+;;; Browse Server Mode
+;;;
+
+(defvar gnus-browse-menu-hook nil
+ "*Hook run after the creation of the browse mode menu.")
+
+(defvar gnus-browse-mode-hook nil)
+(defvar gnus-browse-mode-map nil)
+(put 'gnus-browse-mode 'mode-class 'special)
+
+(unless gnus-browse-mode-map
+ (setq gnus-browse-mode-map (make-keymap))
+ (suppress-keymap gnus-browse-mode-map)
+
+ (gnus-define-keys
+ gnus-browse-mode-map
+ " " gnus-browse-read-group
+ "=" gnus-browse-select-group
+ "n" gnus-browse-next-group
+ "p" gnus-browse-prev-group
+ "\177" gnus-browse-prev-group
+ [delete] gnus-browse-prev-group
+ "N" gnus-browse-next-group
+ "P" gnus-browse-prev-group
+ "\M-n" gnus-browse-next-group
+ "\M-p" gnus-browse-prev-group
+ "\r" gnus-browse-select-group
+ "u" gnus-browse-unsubscribe-current-group
+ "l" gnus-browse-exit
+ "L" gnus-browse-exit
+ "q" gnus-browse-exit
+ "Q" gnus-browse-exit
+ "\C-c\C-c" gnus-browse-exit
+ "?" gnus-browse-describe-briefly
+
+ "\C-c\C-i" gnus-info-find-node
+ "\C-c\C-b" gnus-bug))
+
+(defun gnus-browse-make-menu-bar ()
+ (gnus-turn-off-edit-menu 'browse)
+ (unless (boundp 'gnus-browse-menu)
+ (easy-menu-define
+ gnus-browse-menu gnus-browse-mode-map ""
+ '("Browse"
+ ["Subscribe" gnus-browse-unsubscribe-current-group t]
+ ["Read" gnus-browse-read-group t]
+ ["Select" gnus-browse-read-group t]
+ ["Next" gnus-browse-next-group t]
+ ["Prev" gnus-browse-next-group t]
+ ["Exit" gnus-browse-exit t]))
+ (run-hooks 'gnus-browse-menu-hook)))
+
+(defvar gnus-browse-current-method nil)
+(defvar gnus-browse-return-buffer nil)
+
+(defvar gnus-browse-buffer "*Gnus Browse Server*")
+
+(defun gnus-browse-foreign-server (method &optional return-buffer)
+ "Browse the server METHOD."
+ (setq gnus-browse-current-method method)
+ (setq gnus-browse-return-buffer return-buffer)
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ (let ((gnus-select-method method)
+ groups group)
+ (gnus-message 5 "Connecting to %s..." (nth 1 method))
+ (cond
+ ((not (gnus-check-server method))
+ (gnus-message
+ 1 "Unable to contact server %s: %s" (nth 1 method)
+ (gnus-status-message method))
+ nil)
+ ((not
+ (prog2
+ (gnus-message 6 "Reading active file...")
+ (gnus-request-list method)
+ (gnus-message 6 "Reading active file...done")))
+ (gnus-message
+ 1 "Couldn't request list: %s" (gnus-status-message method))
+ nil)
+ (t
+ (get-buffer-create gnus-browse-buffer)
+ (gnus-add-current-to-buffer-list)
+ (when gnus-carpal
+ (gnus-carpal-setup-buffer 'browse))
+ (gnus-configure-windows 'browse)
+ (buffer-disable-undo (current-buffer))
+ (let ((buffer-read-only nil))
+ (erase-buffer))
+ (gnus-browse-mode)
+ (setq mode-line-buffer-identification
+ (list
+ (format
+ "Gnus: %%b {%s:%s}" (car method) (cadr method))))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let ((cur (current-buffer)))
+ (goto-char (point-min))
+ (unless (string= gnus-ignored-newsgroups "")
+ (delete-matching-lines gnus-ignored-newsgroups))
+ (while (re-search-forward
+ "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
+ (goto-char (match-end 1))
+ (push (cons (match-string 1)
+ (max 0 (- (1+ (read cur)) (read cur))))
+ groups))))
+ (setq groups (sort groups
+ (lambda (l1 l2)
+ (string< (car l1) (car l2)))))
+ (let ((buffer-read-only nil))
+ (while groups
+ (setq group (car groups))
+ (insert
+ (format "K%7d: %s\n" (cdr group) (car group)))
+ (setq groups (cdr groups))))
+ (switch-to-buffer (current-buffer))
+ (goto-char (point-min))
+ (gnus-group-position-point)
+ (gnus-message 5 "Connecting to %s...done" (nth 1 method))
+ t))))
+
+(defun gnus-browse-mode ()
+ "Major mode for browsing a foreign server.
+
+All normal editing commands are switched off.
+
+\\<gnus-browse-mode-map>
+The only things you can do in this buffer is
+
+1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
+The group will be inserted into the group buffer upon exit from this
+buffer.
+
+2) `\\[gnus-browse-read-group]' to read a group ephemerally.
+
+3) `\\[gnus-browse-exit]' to return to the group buffer."
+ (interactive)
+ (kill-all-local-variables)
+ (when (gnus-visual-p 'browse-menu 'menu)
+ (gnus-browse-make-menu-bar))
+ (gnus-simplify-mode-line)
+ (setq major-mode 'gnus-browse-mode)
+ (setq mode-name "Browse Server")
+ (setq mode-line-process nil)
+ (use-local-map gnus-browse-mode-map)
+ (buffer-disable-undo (current-buffer))
+ (setq truncate-lines t)
+ (gnus-set-default-directory)
+ (setq buffer-read-only t)
+ (run-hooks 'gnus-browse-mode-hook))
+
+(defun gnus-browse-read-group (&optional no-article)
+ "Enter the group at the current line."
+ (interactive)
+ (let ((group (gnus-browse-group-name)))
+ (unless (gnus-group-read-ephemeral-group
+ group gnus-browse-current-method nil
+ (cons (current-buffer) 'browse))
+ (error "Couldn't enter %s" group))))
+
+(defun gnus-browse-select-group ()
+ "Select the current group."
+ (interactive)
+ (gnus-browse-read-group 'no))
+
+(defun gnus-browse-next-group (n)
+ "Go to the next group."
+ (interactive "p")
+ (prog1
+ (forward-line n)
+ (gnus-group-position-point)))
+
+(defun gnus-browse-prev-group (n)
+ "Go to the next group."
+ (interactive "p")
+ (gnus-browse-next-group (- n)))
+
+(defun gnus-browse-unsubscribe-current-group (arg)
+ "(Un)subscribe to the next ARG groups."
+ (interactive "p")
+ (when (eobp)
+ (error "No group at current line"))
+ (let ((ward (if (< arg 0) -1 1))
+ (arg (abs arg)))
+ (while (and (> arg 0)
+ (not (eobp))
+ (gnus-browse-unsubscribe-group)
+ (zerop (gnus-browse-next-group ward)))
+ (decf arg))
+ (gnus-group-position-point)
+ (when (/= 0 arg)
+ (gnus-message 7 "No more newsgroups"))
+ arg))
+
+(defun gnus-browse-group-name ()
+ (save-excursion
+ (beginning-of-line)
+ (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
+ (gnus-group-prefixed-name
+ ;; Remove text props.
+ (format "%s" (match-string 1))
+ gnus-browse-current-method))))
+
+(defun gnus-browse-unsubscribe-group ()
+ "Toggle subscription of the current group in the browse buffer."
+ (let ((sub nil)
+ (buffer-read-only nil)
+ group)
+ (save-excursion
+ (beginning-of-line)
+ ;; If this group it killed, then we want to subscribe it.
+ (when (= (following-char) ?K)
+ (setq sub t))
+ (when (gnus-gethash (setq group (gnus-browse-group-name))
+ gnus-newsrc-hashtb)
+ (error "Group already subscribed"))
+ ;; Make sure the group has been properly removed before we
+ ;; subscribe to it.
+ (gnus-kill-ephemeral-group group)
+ (delete-char 1)
+ (if sub
+ (progn
+ (gnus-group-change-level
+ (list t group gnus-level-default-subscribed
+ nil nil gnus-browse-current-method)
+ gnus-level-default-subscribed gnus-level-killed
+ (and (car (nth 1 gnus-newsrc-alist))
+ (gnus-gethash (car (nth 1 gnus-newsrc-alist))
+ gnus-newsrc-hashtb))
+ t)
+ (insert ? ))
+ (gnus-group-change-level
+ group gnus-level-killed gnus-level-default-subscribed)
+ (insert ?K)))
+ t))
+
+(defun gnus-browse-exit ()
+ "Quit browsing and return to the group buffer."
+ (interactive)
+ (when (eq major-mode 'gnus-browse-mode)
+ (kill-buffer (current-buffer)))
+ ;; Insert the newly subscribed groups in the group buffer.
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-group-list-groups nil))
+ (if gnus-browse-return-buffer
+ (gnus-configure-windows 'server 'force)
+ (gnus-configure-windows 'group 'force)))
+
+(defun gnus-browse-describe-briefly ()
+ "Give a one line description of the group mode commands."
+ (interactive)
+ (gnus-message 6
+ (substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help")))
+
+(defun gnus-server-regenerate-server ()
+ "Issue a command to the server to regenerate all its data structures."
+ (interactive)
+ (let ((server (gnus-server-server-name)))
+ (unless server
+ (error "No server on the current line"))
+ (if (not (gnus-check-backend-function
+ 'request-regenerate (car (gnus-server-to-method server))))
+ (error "This backend doesn't support regeneration")
+ (gnus-message 5 "Requesting regeneration of %s..." server)
+ (unless (gnus-open-server server)
+ (error "Couldn't open server"))
+ (if (gnus-request-regenerate server)
+ (gnus-message 5 "Requesting regeneration of %s...done" server)
+ (gnus-message 5 "Couldn't regenerate %s" server)))))
+
+(provide 'gnus-srvr)
+
+;;; gnus-srvr.el ends here.
--- /dev/null
+;;; gnus-start.el --- startup functions for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(require 'gnus-win)
+(require 'gnus-int)
+(require 'gnus-spec)
+(require 'gnus-range)
+(require 'gnus-util)
+(require 'message)
+(eval-when-compile (require 'cl))
+
+(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
+ "Your `.newsrc' file.
+`.newsrc-SERVER' will be used instead if that exists."
+ :group 'gnus-start
+ :type 'file)
+
+(defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
+ "Your Gnus Emacs-Lisp startup file name.
+If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
+ :group 'gnus-start
+ :type 'file)
+
+(defcustom gnus-site-init-file
+ (condition-case nil
+ (concat (file-name-directory
+ (directory-file-name installation-directory))
+ "site-lisp/gnus-init")
+ (error nil))
+ "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
+If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
+ :group 'gnus-start
+ :type '(choice file (const nil)))
+
+(defcustom gnus-default-subscribed-newsgroups nil
+ "List of newsgroups to subscribe, when a user runs Gnus the first time.
+The value should be a list of strings.
+If it is t, Gnus will not do anything special the first time it is
+started; it'll just use the normal newsgroups subscription methods."
+ :group 'gnus-start
+ :type '(choice (repeat string) (const :tag "Nothing special" t)))
+
+(defcustom gnus-use-dribble-file t
+ "*Non-nil means that Gnus will use a dribble file to store user updates.
+If Emacs should crash without saving the .newsrc files, complete
+information can be restored from the dribble file."
+ :group 'gnus-dribble-file
+ :type 'boolean)
+
+(defcustom gnus-dribble-directory nil
+ "*The directory where dribble files will be saved.
+If this variable is nil, the directory where the .newsrc files are
+saved will be used."
+ :group 'gnus-dribble-file
+ :type '(choice directory (const nil)))
+
+(defcustom gnus-check-new-newsgroups 'ask-server
+ "*Non-nil means that Gnus will run gnus-find-new-newsgroups at startup.
+This normally finds new newsgroups by comparing the active groups the
+servers have already reported with those Gnus already knows, either alive
+or killed.
+
+When any of the following are true, gnus-find-new-newsgroups will instead
+ask the servers (primary, secondary, and archive servers) to list new
+groups since the last time it checked:
+ 1. This variable is `ask-server'.
+ 2. This variable is a list of select methods (see below).
+ 3. `gnus-read-active-file' is nil or `some'.
+ 4. A prefix argument is given to gnus-find-new-newsgroups interactively.
+
+Thus, if this variable is `ask-server' or a list of select methods or
+`gnus-read-active-file' is nil or `some', then the killed list is no
+longer necessary, so you could safely set `gnus-save-killed-list' to nil.
+
+This variable can be a list of select methods which Gnus will query with
+the `ask-server' method in addition to the primary, secondary, and archive
+servers.
+
+Eg.
+ (setq gnus-check-new-newsgroups
+ '((nntp \"some.server\") (nntp \"other.server\")))
+
+If this variable is nil, then you have to tell Gnus explicitly to
+check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
+ :group 'gnus-start
+ :type '(choice (const :tag "no" nil)
+ (const :tag "by brute force" t)
+ (const :tag "ask servers" ask-server)
+ (repeat :menu-tag "ask additional servers"
+ :tag "ask additional servers"
+ :value ((nntp ""))
+ (sexp :format "%v"))))
+
+(defcustom gnus-check-bogus-newsgroups nil
+ "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
+If this variable is nil, then you have to tell Gnus explicitly to
+check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups]."
+ :group 'gnus-start-server
+ :type 'boolean)
+
+(defcustom gnus-read-active-file 'some
+ "*Non-nil means that Gnus will read the entire active file at startup.
+If this variable is nil, Gnus will only know about the groups in your
+`.newsrc' file.
+
+If this variable is `some', Gnus will try to only read the relevant
+parts of the active file from the server. Not all servers support
+this, and it might be quite slow with other servers, but this should
+generally be faster than both the t and nil value.
+
+If you set this variable to nil or `some', you probably still want to
+be told about new newsgroups that arrive. To do that, set
+`gnus-check-new-newsgroups' to `ask-server'. This may not work
+properly with all servers."
+ :group 'gnus-start-server
+ :type '(choice (const nil)
+ (const some)
+ (const t)))
+
+(defcustom gnus-level-subscribed 5
+ "*Groups with levels less than or equal to this variable are subscribed."
+ :group 'gnus-group-levels
+ :type 'integer)
+
+(defcustom gnus-level-unsubscribed 7
+ "*Groups with levels less than or equal to this variable are unsubscribed.
+Groups with levels less than `gnus-level-subscribed', which should be
+less than this variable, are subscribed."
+ :group 'gnus-group-levels
+ :type 'integer)
+
+(defcustom gnus-level-zombie 8
+ "*Groups with this level are zombie groups."
+ :group 'gnus-group-levels
+ :type 'integer)
+
+(defcustom gnus-level-killed 9
+ "*Groups with this level are killed."
+ :group 'gnus-group-levels
+ :type 'integer)
+
+(defcustom gnus-level-default-subscribed 3
+ "*New subscribed groups will be subscribed at this level."
+ :group 'gnus-group-levels
+ :type 'integer)
+
+(defcustom gnus-level-default-unsubscribed 6
+ "*New unsubscribed groups will be unsubscribed at this level."
+ :group 'gnus-group-levels
+ :type 'integer)
+
+(defcustom gnus-activate-level (1+ gnus-level-subscribed)
+ "*Groups higher than this level won't be activated on startup.
+Setting this variable to something low might save lots of time when
+you have many groups that you aren't interested in."
+ :group 'gnus-group-levels
+ :type 'integer)
+
+(defcustom gnus-activate-foreign-newsgroups 4
+ "*If nil, Gnus will not check foreign newsgroups at startup.
+If it is non-nil, it should be a number between one and nine. Foreign
+newsgroups that have a level lower or equal to this number will be
+activated on startup. For instance, if you want to active all
+subscribed newsgroups, but not the rest, you'd set this variable to
+`gnus-level-subscribed'.
+
+If you subscribe to lots of newsgroups from different servers, startup
+might take a while. By setting this variable to nil, you'll save time,
+but you won't be told how many unread articles there are in the
+groups."
+ :group 'gnus-group-levels
+ :type 'integer)
+
+(defcustom gnus-save-newsrc-file t
+ "*Non-nil means that Gnus will save the `.newsrc' file.
+Gnus always saves its own startup file, which is called
+\".newsrc.eld\". The file called \".newsrc\" is in a format that can
+be readily understood by other newsreaders. If you don't plan on
+using other newsreaders, set this variable to nil to save some time on
+exit."
+ :group 'gnus-newsrc
+ :type 'boolean)
+
+(defcustom gnus-save-killed-list t
+ "*If non-nil, save the list of killed groups to the startup file.
+If you set this variable to nil, you'll save both time (when starting
+and quitting) and space (both memory and disk), but it will also mean
+that Gnus has no record of which groups are new and which are old, so
+the automatic new newsgroups subscription methods become meaningless.
+
+You should always set `gnus-check-new-newsgroups' to `ask-server' or
+nil if you set this variable to nil.
+
+This variable can also be a regexp. In that case, all groups that do
+not match this regexp will be removed before saving the list."
+ :group 'gnus-newsrc
+ :type 'boolean)
+
+(defcustom gnus-ignored-newsgroups
+ (purecopy (mapconcat 'identity
+ '("^to\\." ; not "real" groups
+ "^[0-9. \t]+ " ; all digits in name
+ "[][\"#'()]" ; bogus characters
+ )
+ "\\|"))
+ "A regexp to match uninteresting newsgroups in the active file.
+Any lines in the active file matching this regular expression are
+removed from the newsgroup list before anything else is done to it,
+thus making them effectively non-existent."
+ :group 'gnus-group-new
+ :type 'regexp)
+
+(defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
+ "*Function called with a group name when new group is detected.
+A few pre-made functions are supplied: `gnus-subscribe-randomly'
+inserts new groups at the beginning of the list of groups;
+`gnus-subscribe-alphabetically' inserts new groups in strict
+alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
+in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
+for your decision; `gnus-subscribe-killed' kills all new groups;
+`gnus-subscribe-zombies' will make all new groups into zombies."
+ :group 'gnus-group-new
+ :type '(radio (function-item gnus-subscribe-randomly)
+ (function-item gnus-subscribe-alphabetically)
+ (function-item gnus-subscribe-hierarchically)
+ (function-item gnus-subscribe-interactively)
+ (function-item gnus-subscribe-killed)
+ (function-item gnus-subscribe-zombies)
+ function))
+
+;; Suggested by a bug report by Hallvard B Furuseth.
+;; <h.b.furuseth@usit.uio.no>.
+(defcustom gnus-subscribe-options-newsgroup-method
+ 'gnus-subscribe-alphabetically
+ "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
+If, for instance, you want to subscribe to all newsgroups in the
+\"no\" and \"alt\" hierarchies, you'd put the following in your
+.newsrc file:
+
+options -n no.all alt.all
+
+Gnus will the subscribe all new newsgroups in these hierarchies with
+the subscription method in this variable."
+ :group 'gnus-group-new
+ :type '(radio (function-item gnus-subscribe-randomly)
+ (function-item gnus-subscribe-alphabetically)
+ (function-item gnus-subscribe-hierarchically)
+ (function-item gnus-subscribe-interactively)
+ (function-item gnus-subscribe-killed)
+ (function-item gnus-subscribe-zombies)
+ function))
+
+(defcustom gnus-subscribe-hierarchical-interactive nil
+ "*If non-nil, Gnus will offer to subscribe hierarchically.
+When a new hierarchy appears, Gnus will ask the user:
+
+'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
+
+If the user pressed `d', Gnus will descend the hierarchy, `y' will
+subscribe to all newsgroups in the hierarchy and `s' will skip this
+hierarchy in its entirety."
+ :group 'gnus-group-new
+ :type 'boolean)
+
+(defcustom gnus-auto-subscribed-groups
+ "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
+ "*All new groups that match this regexp will be subscribed automatically.
+Note that this variable only deals with new groups. It has no effect
+whatsoever on old groups.
+
+New groups that match this regexp will not be handled by
+`gnus-subscribe-newsgroup-method'. Instead, they will
+be subscribed using `gnus-subscribe-options-newsgroup-method'."
+ :group 'gnus-group-new
+ :type 'regexp)
+
+(defcustom gnus-options-subscribe nil
+ "*All new groups matching this regexp will be subscribed unconditionally.
+Note that this variable deals only with new newsgroups. This variable
+does not affect old newsgroups.
+
+New groups that match this regexp will not be handled by
+`gnus-subscribe-newsgroup-method'. Instead, they will
+be subscribed using `gnus-subscribe-options-newsgroup-method'."
+ :group 'gnus-group-new
+ :type '(choice regexp
+ (const :tag "none" nil)))
+
+(defcustom gnus-options-not-subscribe nil
+ "*All new groups matching this regexp will be ignored.
+Note that this variable deals only with new newsgroups. This variable
+does not affect old (already subscribed) newsgroups."
+ :group 'gnus-group-new
+ :type '(choice regexp
+ (const :tag "none" nil)))
+
+(defcustom gnus-modtime-botch nil
+ "*Non-nil means .newsrc should be deleted prior to save.
+Its use is due to the bogus appearance that .newsrc was modified on
+disc."
+ :group 'gnus-newsrc
+ :type 'boolean)
+
+(defcustom gnus-check-bogus-groups-hook nil
+ "A hook run after removing bogus groups."
+ :group 'gnus-start-server
+ :type 'hook)
+
+(defcustom gnus-startup-hook nil
+ "A hook called at startup.
+This hook is called after Gnus is connected to the NNTP server."
+ :group 'gnus-start
+ :type 'hook)
+
+(defcustom gnus-before-startup-hook nil
+ "A hook called at before startup.
+This hook is called as the first thing when Gnus is started."
+ :group 'gnus-start
+ :type 'hook)
+
+(defcustom gnus-started-hook nil
+ "A hook called as the last thing after startup."
+ :group 'gnus-start
+ :type 'hook)
+
+(defcustom gnus-setup-news-hook nil
+ "A hook after reading the .newsrc file, but before generating the buffer."
+ :group 'gnus-start
+ :type 'hook)
+
+(defcustom gnus-get-new-news-hook nil
+ "A hook run just before Gnus checks for new news."
+ :group 'gnus-group-new
+ :type 'hook)
+
+(defcustom gnus-after-getting-new-news-hook
+ (when (gnus-boundp 'display-time-timer)
+ '(display-time-event-handler))
+ "A hook run after Gnus checks for new news."
+ :group 'gnus-group-new
+ :type 'hook)
+
+(defcustom gnus-save-newsrc-hook nil
+ "A hook called before saving any of the newsrc files."
+ :group 'gnus-newsrc
+ :type 'hook)
+
+(defcustom gnus-save-quick-newsrc-hook nil
+ "A hook called just before saving the quick newsrc file.
+Can be used to turn version control on or off."
+ :group 'gnus-newsrc
+ :type 'hook)
+
+(defcustom gnus-save-standard-newsrc-hook nil
+ "A hook called just before saving the standard newsrc file.
+Can be used to turn version control on or off."
+ :group 'gnus-newsrc
+ :type 'hook)
+
+;;; Internal variables
+
+(defvar gnus-newsrc-file-version nil)
+(defvar gnus-override-subscribe-method nil)
+(defvar gnus-dribble-buffer nil)
+(defvar gnus-newsrc-options nil
+ "Options line in the .newsrc file.")
+
+(defvar gnus-newsrc-options-n nil
+ "List of regexps representing groups to be subscribed/ignored unconditionally.")
+
+(defvar gnus-newsrc-last-checked-date nil
+ "Date Gnus last asked server for new newsgroups.")
+
+(defvar gnus-current-startup-file nil
+ "Startup file for the current host.")
+
+;; Byte-compiler warning.
+(defvar gnus-group-line-format)
+
+;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
+(defvar gnus-init-inhibit nil)
+(defun gnus-read-init-file (&optional inhibit-next)
+ ;; Don't load .gnus if the -q option was used.
+ (when init-file-user
+ (if gnus-init-inhibit
+ (setq gnus-init-inhibit nil)
+ (setq gnus-init-inhibit inhibit-next)
+ (let ((files (list gnus-site-init-file gnus-init-file))
+ file)
+ (while files
+ (and (setq file (pop files))
+ (or (and (file-exists-p file)
+ ;; Don't try to load a directory.
+ (not (file-directory-p file)))
+ (file-exists-p (concat file ".el"))
+ (file-exists-p (concat file ".elc")))
+ (condition-case var
+ (load file nil t)
+ (error
+ (error "Error in %s: %s" file var)))))))))
+
+;; For subscribing new newsgroup
+
+(defun gnus-subscribe-hierarchical-interactive (groups)
+ (let ((groups (sort groups 'string<))
+ prefixes prefix start ans group starts)
+ (while groups
+ (setq prefixes (list "^"))
+ (while (and groups prefixes)
+ (while (not (string-match (car prefixes) (car groups)))
+ (setq prefixes (cdr prefixes)))
+ (setq prefix (car prefixes))
+ (setq start (1- (length prefix)))
+ (if (and (string-match "[^\\.]\\." (car groups) start)
+ (cdr groups)
+ (setq prefix
+ (concat "^" (substring (car groups) 0 (match-end 0))))
+ (string-match prefix (cadr groups)))
+ (progn
+ (push prefix prefixes)
+ (message "Descend hierarchy %s? ([y]nsq): "
+ (substring prefix 1 (1- (length prefix))))
+ (while (not (memq (setq ans (read-char)) '(?y ?\n ?\r ?n ?s ?q)))
+ (ding)
+ (message "Descend hierarchy %s? ([y]nsq): "
+ (substring prefix 1 (1- (length prefix)))))
+ (cond ((= ans ?n)
+ (while (and groups
+ (string-match prefix
+ (setq group (car groups))))
+ (push group gnus-killed-list)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (setq groups (cdr groups)))
+ (setq starts (cdr starts)))
+ ((= ans ?s)
+ (while (and groups
+ (string-match prefix
+ (setq group (car groups))))
+ (gnus-sethash group group gnus-killed-hashtb)
+ (gnus-subscribe-alphabetically (car groups))
+ (setq groups (cdr groups)))
+ (setq starts (cdr starts)))
+ ((= ans ?q)
+ (while groups
+ (setq group (car groups))
+ (push group gnus-killed-list)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (setq groups (cdr groups))))
+ (t nil)))
+ (message "Subscribe %s? ([n]yq)" (car groups))
+ (while (not (memq (setq ans (read-char)) '(?y ?\n ?\r ?q ?n)))
+ (ding)
+ (message "Subscribe %s? ([n]yq)" (car groups)))
+ (setq group (car groups))
+ (cond ((= ans ?y)
+ (gnus-subscribe-alphabetically (car groups))
+ (gnus-sethash group group gnus-killed-hashtb))
+ ((= ans ?q)
+ (while groups
+ (setq group (car groups))
+ (push group gnus-killed-list)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (setq groups (cdr groups))))
+ (t
+ (push group gnus-killed-list)
+ (gnus-sethash group group gnus-killed-hashtb)))
+ (setq groups (cdr groups)))))))
+
+(defun gnus-subscribe-randomly (newsgroup)
+ "Subscribe new NEWSGROUP by making it the first newsgroup."
+ (gnus-subscribe-newsgroup newsgroup))
+
+(defun gnus-subscribe-alphabetically (newgroup)
+ "Subscribe new NEWSGROUP and insert it in alphabetical order."
+ (let ((groups (cdr gnus-newsrc-alist))
+ before)
+ (while (and (not before) groups)
+ (if (string< newgroup (caar groups))
+ (setq before (caar groups))
+ (setq groups (cdr groups))))
+ (gnus-subscribe-newsgroup newgroup before)))
+
+(defun gnus-subscribe-hierarchically (newgroup)
+ "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
+ ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
+ (save-excursion
+ (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
+ (let ((groupkey newgroup)
+ before)
+ (while (and (not before) groupkey)
+ (goto-char (point-min))
+ (let ((groupkey-re
+ (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
+ (while (and (re-search-forward groupkey-re nil t)
+ (progn
+ (setq before (match-string 1))
+ (string< before newgroup)))))
+ ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
+ (setq groupkey
+ (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
+ (substring groupkey (match-beginning 1) (match-end 1)))))
+ (gnus-subscribe-newsgroup newgroup before))
+ (kill-buffer (current-buffer))))
+
+(defun gnus-subscribe-interactively (group)
+ "Subscribe the new GROUP interactively.
+It is inserted in hierarchical newsgroup order if subscribed. If not,
+it is killed."
+ (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
+ (gnus-subscribe-hierarchically group)
+ (push group gnus-killed-list)))
+
+(defun gnus-subscribe-zombies (group)
+ "Make the new GROUP into a zombie group."
+ (push group gnus-zombie-list))
+
+(defun gnus-subscribe-killed (group)
+ "Make the new GROUP a killed group."
+ (push group gnus-killed-list))
+
+(defun gnus-subscribe-newsgroup (newsgroup &optional next)
+ "Subscribe new NEWSGROUP.
+If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
+the first newsgroup."
+ (save-excursion
+ (goto-char (point-min))
+ ;; We subscribe the group by changing its level to `subscribed'.
+ (gnus-group-change-level
+ newsgroup gnus-level-default-subscribed
+ gnus-level-killed (gnus-gethash (or next "dummy.group")
+ gnus-newsrc-hashtb))
+ (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)))
+
+(defun gnus-read-active-file-p ()
+ "Say whether the active file has been read from `gnus-select-method'."
+ (memq gnus-select-method gnus-have-read-active-file))
+
+;;; General various misc type functions.
+
+;; Silence byte-compiler.
+(defvar gnus-current-headers)
+(defvar gnus-thread-indent-array)
+(defvar gnus-newsgroup-name)
+(defvar gnus-newsgroup-headers)
+(defvar gnus-group-list-mode)
+(defvar gnus-group-mark-positions)
+(defvar gnus-newsgroup-data)
+(defvar gnus-newsgroup-unreads)
+(defvar nnoo-state-alist)
+(defvar gnus-current-select-method)
+(defun gnus-clear-system ()
+ "Clear all variables and buffers."
+ ;; Clear Gnus variables.
+ (let ((variables gnus-variable-list))
+ (while variables
+ (set (car variables) nil)
+ (setq variables (cdr variables))))
+ ;; Clear other internal variables.
+ (setq gnus-list-of-killed-groups nil
+ gnus-have-read-active-file nil
+ gnus-newsrc-alist nil
+ gnus-newsrc-hashtb nil
+ gnus-killed-list nil
+ gnus-zombie-list nil
+ gnus-killed-hashtb nil
+ gnus-active-hashtb nil
+ gnus-moderated-hashtb nil
+ gnus-description-hashtb nil
+ gnus-current-headers nil
+ gnus-thread-indent-array nil
+ gnus-newsgroup-headers nil
+ gnus-newsgroup-name nil
+ gnus-server-alist nil
+ gnus-group-list-mode nil
+ gnus-opened-servers nil
+ gnus-group-mark-positions nil
+ gnus-newsgroup-data nil
+ gnus-newsgroup-unreads nil
+ nnoo-state-alist nil
+ gnus-current-select-method nil)
+ (gnus-shutdown 'gnus)
+ ;; Kill the startup file.
+ (and gnus-current-startup-file
+ (get-file-buffer gnus-current-startup-file)
+ (kill-buffer (get-file-buffer gnus-current-startup-file)))
+ ;; Clear the dribble buffer.
+ (gnus-dribble-clear)
+ ;; Kill global KILL file buffer.
+ (when (get-file-buffer (gnus-newsgroup-kill-file nil))
+ (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
+ (gnus-kill-buffer nntp-server-buffer)
+ ;; Kill Gnus buffers.
+ (while gnus-buffer-list
+ (gnus-kill-buffer (pop gnus-buffer-list)))
+ ;; Remove Gnus frames.
+ (gnus-kill-gnus-frames))
+
+(defun gnus-no-server-1 (&optional arg slave)
+ "Read network news.
+If ARG is a positive number, Gnus will use that as the
+startup level. If ARG is nil, Gnus will be started at level 2.
+If ARG is non-nil and not a positive number, Gnus will
+prompt the user for the name of an NNTP server to use.
+As opposed to `gnus', this command will not connect to the local server."
+ (interactive "P")
+ (let ((val (or arg (1- gnus-level-default-subscribed))))
+ (gnus val t slave)
+ (make-local-variable 'gnus-group-use-permanent-levels)
+ (setq gnus-group-use-permanent-levels val)))
+
+(defun gnus-1 (&optional arg dont-connect slave)
+ "Read network news.
+If ARG is non-nil and a positive number, Gnus will use that as the
+startup level. If ARG is non-nil and not a positive number, Gnus will
+prompt the user for the name of an NNTP server to use."
+ (interactive "P")
+
+ (if (and (get-buffer gnus-group-buffer)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (eq major-mode 'gnus-group-mode)))
+ (progn
+ (switch-to-buffer gnus-group-buffer)
+ (gnus-group-get-new-news
+ (and (numberp arg)
+ (> arg 0)
+ (max (car gnus-group-list-mode) arg))))
+
+ (gnus-splash)
+ (gnus-clear-system)
+ (run-hooks 'gnus-before-startup-hook)
+ (nnheader-init-server-buffer)
+ (setq gnus-slave slave)
+ (gnus-read-init-file)
+
+ (when gnus-simple-splash
+ (setq gnus-simple-splash nil)
+ (cond
+ (gnus-xemacs
+ (gnus-xmas-splash))
+ ((and (eq window-system 'x)
+ (= (frame-height) (1+ (window-height))))
+ (gnus-x-splash))))
+
+ (let ((level (and (numberp arg) (> arg 0) arg))
+ did-connect)
+ (unwind-protect
+ (progn
+ (unless dont-connect
+ (setq did-connect
+ (gnus-start-news-server (and arg (not level))))))
+ (if (and (not dont-connect)
+ (not did-connect))
+ (gnus-group-quit)
+ (run-hooks 'gnus-startup-hook)
+ ;; NNTP server is successfully open.
+
+ ;; Find the current startup file name.
+ (setq gnus-current-startup-file
+ (gnus-make-newsrc-file gnus-startup-file))
+
+ ;; Read the dribble file.
+ (when (or gnus-slave gnus-use-dribble-file)
+ (gnus-dribble-read-file))
+
+ ;; Allow using GroupLens predictions.
+ (when gnus-use-grouplens
+ (bbb-login)
+ (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
+
+ ;; Do the actual startup.
+ (gnus-setup-news nil level dont-connect)
+ (run-hooks 'gnus-setup-news-hook)
+ (gnus-start-draft-setup)
+ ;; Generate the group buffer.
+ (gnus-group-list-groups level)
+ (gnus-group-first-unread-group)
+ (gnus-configure-windows 'group)
+ (gnus-group-set-mode-line)
+ (run-hooks 'gnus-started-hook))))))
+
+(defun gnus-start-draft-setup ()
+ "Make sure the draft group exists."
+ (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb)
+ (gnus-request-create-group "drafts" '(nndraft ""))
+ (let ((gnus-level-default-subscribed 1))
+ (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))
+ (gnus-group-set-parameter
+ "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
+
+;;;###autoload
+(defun gnus-unload ()
+ "Unload all Gnus features."
+ (interactive)
+ (unless (boundp 'load-history)
+ (error "Sorry, `gnus-unload' is not implemented in this Emacs version"))
+ (let ((history load-history)
+ feature)
+ (while history
+ (and (string-match "^\\(gnus\\|nn\\)" (caar history))
+ (setq feature (cdr (assq 'provide (car history))))
+ (unload-feature feature 'force))
+ (setq history (cdr history)))))
+
+\f
+;;;
+;;; Dribble file
+;;;
+
+(defvar gnus-dribble-ignore nil)
+(defvar gnus-dribble-eval-file nil)
+
+(defun gnus-dribble-file-name ()
+ "Return the dribble file for the current .newsrc."
+ (concat
+ (if gnus-dribble-directory
+ (concat (file-name-as-directory gnus-dribble-directory)
+ (file-name-nondirectory gnus-current-startup-file))
+ gnus-current-startup-file)
+ "-dribble"))
+
+(defun gnus-dribble-enter (string)
+ "Enter STRING into the dribble buffer."
+ (when (and (not gnus-dribble-ignore)
+ gnus-dribble-buffer
+ (buffer-name gnus-dribble-buffer))
+ (let ((obuf (current-buffer)))
+ (set-buffer gnus-dribble-buffer)
+ (goto-char (point-max))
+ (insert string "\n")
+ (set-window-point (get-buffer-window (current-buffer)) (point-max))
+ (bury-buffer gnus-dribble-buffer)
+ (set-buffer obuf))))
+
+(defun gnus-dribble-touch ()
+ "Touch the dribble buffer."
+ (gnus-dribble-enter ""))
+
+(defun gnus-dribble-read-file ()
+ "Read the dribble file from disk."
+ (let ((dribble-file (gnus-dribble-file-name)))
+ (save-excursion
+ (set-buffer (setq gnus-dribble-buffer
+ (get-buffer-create
+ (file-name-nondirectory dribble-file))))
+ (gnus-add-current-to-buffer-list)
+ (erase-buffer)
+ (setq buffer-file-name dribble-file)
+ (auto-save-mode t)
+ (buffer-disable-undo (current-buffer))
+ (bury-buffer (current-buffer))
+ (set-buffer-modified-p nil)
+ (let ((auto (make-auto-save-file-name))
+ (gnus-dribble-ignore t)
+ modes)
+ (when (or (file-exists-p auto) (file-exists-p dribble-file))
+ ;; Load whichever file is newest -- the auto save file
+ ;; or the "real" file.
+ (if (file-newer-than-file-p auto dribble-file)
+ (nnheader-insert-file-contents auto)
+ (nnheader-insert-file-contents dribble-file))
+ (unless (zerop (buffer-size))
+ (set-buffer-modified-p t))
+ ;; Set the file modes to reflect the .newsrc file modes.
+ (save-buffer)
+ (when (and (file-exists-p gnus-current-startup-file)
+ (file-exists-p dribble-file)
+ (setq modes (file-modes gnus-current-startup-file)))
+ (set-file-modes dribble-file modes))
+ ;; Possibly eval the file later.
+ (when (gnus-y-or-n-p
+ "Gnus auto-save file exists. Do you want to read it? ")
+ (setq gnus-dribble-eval-file t)))))))
+
+(defun gnus-dribble-eval-file ()
+ (when gnus-dribble-eval-file
+ (setq gnus-dribble-eval-file nil)
+ (save-excursion
+ (let ((gnus-dribble-ignore t))
+ (set-buffer gnus-dribble-buffer)
+ (eval-buffer (current-buffer))))))
+
+(defun gnus-dribble-delete-file ()
+ (when (file-exists-p (gnus-dribble-file-name))
+ (delete-file (gnus-dribble-file-name)))
+ (when gnus-dribble-buffer
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (let ((auto (make-auto-save-file-name)))
+ (when (file-exists-p auto)
+ (delete-file auto))
+ (erase-buffer)
+ (set-buffer-modified-p nil)))))
+
+(defun gnus-dribble-save ()
+ (when (and gnus-dribble-buffer
+ (buffer-name gnus-dribble-buffer))
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (save-buffer))))
+
+(defun gnus-dribble-clear ()
+ (when (gnus-buffer-exists-p gnus-dribble-buffer)
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (erase-buffer)
+ (set-buffer-modified-p nil)
+ (setq buffer-saved-size (buffer-size)))))
+
+\f
+;;;
+;;; Active & Newsrc File Handling
+;;;
+
+(defun gnus-setup-news (&optional rawfile level dont-connect)
+ "Setup news information.
+If RAWFILE is non-nil, the .newsrc file will also be read.
+If LEVEL is non-nil, the news will be set up at level LEVEL."
+ (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
+
+ (when init
+ ;; Clear some variables to re-initialize news information.
+ (setq gnus-newsrc-alist nil
+ gnus-active-hashtb nil)
+ ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
+ (gnus-read-newsrc-file rawfile))
+
+ (when (and (not (assoc "archive" gnus-server-alist))
+ (gnus-archive-server-wanted-p))
+ (push (cons "archive" gnus-message-archive-method)
+ gnus-server-alist))
+
+ ;; If we don't read the complete active file, we fill in the
+ ;; hashtb here.
+ (when (or (null gnus-read-active-file)
+ (eq gnus-read-active-file 'some))
+ (gnus-update-active-hashtb-from-killed))
+
+ ;; Read the active file and create `gnus-active-hashtb'.
+ ;; If `gnus-read-active-file' is nil, then we just create an empty
+ ;; hash table. The partial filling out of the hash table will be
+ ;; done in `gnus-get-unread-articles'.
+ (and gnus-read-active-file
+ (not level)
+ (gnus-read-active-file nil dont-connect))
+
+ (unless gnus-active-hashtb
+ (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
+
+ ;; Initialize the cache.
+ (when gnus-use-cache
+ (gnus-cache-open))
+
+ ;; Possibly eval the dribble file.
+ (and init
+ (or gnus-use-dribble-file gnus-slave)
+ (gnus-dribble-eval-file))
+
+ ;; Slave Gnusii should then clear the dribble buffer.
+ (when (and init gnus-slave)
+ (gnus-dribble-clear))
+
+ (gnus-update-format-specifications)
+
+ ;; See whether we need to read the description file.
+ (when (and (boundp 'gnus-group-line-format)
+ (let ((case-fold-search nil))
+ (string-match "%[-,0-9]*D" gnus-group-line-format))
+ (not gnus-description-hashtb)
+ (not dont-connect)
+ gnus-read-active-file)
+ (gnus-read-all-descriptions-files))
+
+ ;; Find new newsgroups and treat them.
+ (when (and init gnus-check-new-newsgroups (not level)
+ (gnus-check-server gnus-select-method)
+ (not gnus-slave))
+ (gnus-find-new-newsgroups))
+
+ ;; We might read in new NoCeM messages here.
+ (when (and gnus-use-nocem
+ (not level)
+ (not dont-connect))
+ (gnus-nocem-scan-groups))
+
+ ;; Read any slave files.
+ (gnus-master-read-slave-newsrc)
+
+ ;; Find the number of unread articles in each non-dead group.
+ (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
+ (gnus-get-unread-articles level))
+
+ (when (and init gnus-check-bogus-newsgroups
+ gnus-read-active-file (not level)
+ (gnus-server-opened gnus-select-method))
+ (gnus-check-bogus-newsgroups))))
+
+(defun gnus-find-new-newsgroups (&optional arg)
+ "Search for new newsgroups and add them.
+Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
+The `-n' option line from .newsrc is respected.
+If ARG (the prefix), use the `ask-server' method to query the server
+for new groups."
+ (interactive "P")
+ (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
+ (null gnus-read-active-file)
+ (eq gnus-read-active-file 'some))
+ 'ask-server gnus-check-new-newsgroups)))
+ (unless (gnus-check-first-time-used)
+ (if (or (consp check)
+ (eq check 'ask-server))
+ ;; Ask the server for new groups.
+ (gnus-ask-server-for-new-groups)
+ ;; Go through the active hashtb and look for new groups.
+ (let ((groups 0)
+ group new-newsgroups)
+ (gnus-message 5 "Looking for new newsgroups...")
+ (unless gnus-have-read-active-file
+ (gnus-read-active-file))
+ (setq gnus-newsrc-last-checked-date (current-time-string))
+ (unless gnus-killed-hashtb
+ (gnus-make-hashtable-from-killed))
+ ;; Go though every newsgroup in `gnus-active-hashtb' and compare
+ ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
+ (mapatoms
+ (lambda (sym)
+ (if (or (null (setq group (symbol-name sym)))
+ (not (boundp sym))
+ (null (symbol-value sym))
+ (gnus-gethash group gnus-killed-hashtb)
+ (gnus-gethash group gnus-newsrc-hashtb))
+ ()
+ (let ((do-sub (gnus-matches-options-n group)))
+ (cond
+ ((eq do-sub 'subscribe)
+ (setq groups (1+ groups))
+ (gnus-sethash group group gnus-killed-hashtb)
+ (funcall gnus-subscribe-options-newsgroup-method group))
+ ((eq do-sub 'ignore)
+ nil)
+ (t
+ (setq groups (1+ groups))
+ (gnus-sethash group group gnus-killed-hashtb)
+ (if gnus-subscribe-hierarchical-interactive
+ (push group new-newsgroups)
+ (funcall gnus-subscribe-newsgroup-method group)))))))
+ gnus-active-hashtb)
+ (when new-newsgroups
+ (gnus-subscribe-hierarchical-interactive new-newsgroups))
+ (if (> groups 0)
+ (gnus-message 5 "%d new newsgroup%s arrived."
+ groups (if (> groups 1) "s have" " has"))
+ (gnus-message 5 "No new newsgroups.")))))))
+
+(defun gnus-matches-options-n (group)
+ ;; Returns `subscribe' if the group is to be unconditionally
+ ;; subscribed, `ignore' if it is to be ignored, and nil if there is
+ ;; no match for the group.
+
+ ;; First we check the two user variables.
+ (cond
+ ((and gnus-options-subscribe
+ (string-match gnus-options-subscribe group))
+ 'subscribe)
+ ((and gnus-auto-subscribed-groups
+ (string-match gnus-auto-subscribed-groups group))
+ 'subscribe)
+ ((and gnus-options-not-subscribe
+ (string-match gnus-options-not-subscribe group))
+ 'ignore)
+ ;; Then we go through the list that was retrieved from the .newsrc
+ ;; file. This list has elements on the form
+ ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list
+ ;; is in the reverse order of the options line) is returned.
+ (t
+ (let ((regs gnus-newsrc-options-n))
+ (while (and regs
+ (not (string-match (caar regs) group)))
+ (setq regs (cdr regs)))
+ (and regs (cdar regs))))))
+
+(defun gnus-ask-server-for-new-groups ()
+ (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
+ (methods (cons gnus-select-method
+ (nconc
+ (when (gnus-archive-server-wanted-p)
+ (list "archive"))
+ (append
+ (and (consp gnus-check-new-newsgroups)
+ gnus-check-new-newsgroups)
+ gnus-secondary-select-methods))))
+ (groups 0)
+ (new-date (current-time-string))
+ group new-newsgroups got-new method hashtb
+ gnus-override-subscribe-method)
+ ;; Go through both primary and secondary select methods and
+ ;; request new newsgroups.
+ (while (setq method (gnus-server-get-method nil (pop methods)))
+ (setq new-newsgroups nil)
+ (setq gnus-override-subscribe-method method)
+ (when (and (gnus-check-server method)
+ (gnus-request-newgroups date method))
+ (save-excursion
+ (setq got-new t)
+ (setq hashtb (gnus-make-hashtable 100))
+ (set-buffer nntp-server-buffer)
+ ;; Enter all the new groups into a hashtable.
+ (gnus-active-to-gnus-format method hashtb 'ignore))
+ ;; Now all new groups from `method' are in `hashtb'.
+ (mapatoms
+ (lambda (group-sym)
+ (if (or (null (setq group (symbol-name group-sym)))
+ (not (boundp group-sym))
+ (null (symbol-value group-sym))
+ (gnus-gethash group gnus-newsrc-hashtb)
+ (member group gnus-zombie-list)
+ (member group gnus-killed-list))
+ ;; The group is already known.
+ ()
+ ;; Make this group active.
+ (when (symbol-value group-sym)
+ (gnus-set-active group (symbol-value group-sym)))
+ ;; Check whether we want it or not.
+ (let ((do-sub (gnus-matches-options-n group)))
+ (cond
+ ((eq do-sub 'subscribe)
+ (incf groups)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (funcall gnus-subscribe-options-newsgroup-method group))
+ ((eq do-sub 'ignore)
+ nil)
+ (t
+ (incf groups)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (if gnus-subscribe-hierarchical-interactive
+ (push group new-newsgroups)
+ (funcall gnus-subscribe-newsgroup-method group)))))))
+ hashtb))
+ (when new-newsgroups
+ (gnus-subscribe-hierarchical-interactive new-newsgroups)))
+ ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
+ (when (> groups 0)
+ (gnus-message 6 "%d new newsgroup%s arrived."
+ groups (if (> groups 1) "s have" " has")))
+ (when got-new
+ (setq gnus-newsrc-last-checked-date new-date))
+ got-new))
+
+(defun gnus-check-first-time-used ()
+ (if (or (> (length gnus-newsrc-alist) 1)
+ (file-exists-p gnus-startup-file)
+ (file-exists-p (concat gnus-startup-file ".el"))
+ (file-exists-p (concat gnus-startup-file ".eld")))
+ nil
+ (gnus-message 6 "First time user; subscribing you to default groups")
+ (unless (gnus-read-active-file-p)
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file)))
+ (setq gnus-newsrc-last-checked-date (current-time-string))
+ (let ((groups gnus-default-subscribed-newsgroups)
+ group)
+ (if (eq groups t)
+ nil
+ (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
+ (mapatoms
+ (lambda (sym)
+ (if (null (setq group (symbol-name sym)))
+ ()
+ (let ((do-sub (gnus-matches-options-n group)))
+ (cond
+ ((eq do-sub 'subscribe)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (funcall gnus-subscribe-options-newsgroup-method group))
+ ((eq do-sub 'ignore)
+ nil)
+ (t
+ (push group gnus-killed-list))))))
+ gnus-active-hashtb)
+ (while groups
+ (when (gnus-active (car groups))
+ (gnus-group-change-level
+ (car groups) gnus-level-default-subscribed gnus-level-killed))
+ (setq groups (cdr groups)))
+ (gnus-group-make-help-group)
+ (when gnus-novice-user
+ (gnus-message 7 "`A k' to list killed groups"))))))
+
+(defun gnus-subscribe-group (group previous &optional method)
+ (gnus-group-change-level
+ (if method
+ (list t group gnus-level-default-subscribed nil nil method)
+ group)
+ gnus-level-default-subscribed gnus-level-killed previous t))
+
+;; `gnus-group-change-level' is the fundamental function for changing
+;; subscription levels of newsgroups. This might mean just changing
+;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
+;; again, which subscribes/unsubscribes a group, which is equally
+;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and
+;; from 8-9 to 1-7 means that you remove the group from the list of
+;; killed (or zombie) groups and add them to the (kinda) subscribed
+;; groups. And last but not least, moving from 8 to 9 and 9 to 8,
+;; which is trivial.
+;; ENTRY can either be a string (newsgroup name) or a list (if
+;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
+;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
+;; entries.
+;; LEVEL is the new level of the group, OLDLEVEL is the old level and
+;; PREVIOUS is the group (in hashtb entry format) to insert this group
+;; after.
+(defun gnus-group-change-level (entry level &optional oldlevel
+ previous fromkilled)
+ (let (group info active num)
+ ;; Glean what info we can from the arguments
+ (if (consp entry)
+ (if fromkilled (setq group (nth 1 entry))
+ (setq group (car (nth 2 entry))))
+ (setq group entry))
+ (when (and (stringp entry)
+ oldlevel
+ (< oldlevel gnus-level-zombie))
+ (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
+ (if (and (not oldlevel)
+ (consp entry))
+ (setq oldlevel (gnus-info-level (nth 2 entry)))
+ (setq oldlevel (or oldlevel 9)))
+ (when (stringp previous)
+ (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
+
+ (if (and (>= oldlevel gnus-level-zombie)
+ (gnus-gethash group gnus-newsrc-hashtb))
+ ;; We are trying to subscribe a group that is already
+ ;; subscribed.
+ () ; Do nothing.
+
+ (unless (gnus-ephemeral-group-p group)
+ (gnus-dribble-enter
+ (format "(gnus-group-change-level %S %S %S %S %S)"
+ group level oldlevel (car (nth 2 previous)) fromkilled)))
+
+ ;; Then we remove the newgroup from any old structures, if needed.
+ ;; If the group was killed, we remove it from the killed or zombie
+ ;; list. If not, and it is in fact going to be killed, we remove
+ ;; it from the newsrc hash table and assoc.
+ (cond
+ ((>= oldlevel gnus-level-zombie)
+ (if (= oldlevel gnus-level-zombie)
+ (setq gnus-zombie-list (delete group gnus-zombie-list))
+ (setq gnus-killed-list (delete group gnus-killed-list))))
+ (t
+ (when (and (>= level gnus-level-zombie)
+ entry)
+ (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
+ (when (nth 3 entry)
+ (setcdr (gnus-gethash (car (nth 3 entry))
+ gnus-newsrc-hashtb)
+ (cdr entry)))
+ (setcdr (cdr entry) (cdddr entry)))))
+
+ ;; Finally we enter (if needed) the list where it is supposed to
+ ;; go, and change the subscription level. If it is to be killed,
+ ;; we enter it into the killed or zombie list.
+ (cond
+ ((>= level gnus-level-zombie)
+ ;; Remove from the hash table.
+ (gnus-sethash group nil gnus-newsrc-hashtb)
+ ;; We do not enter foreign groups into the list of dead
+ ;; groups.
+ (unless (gnus-group-foreign-p group)
+ (if (= level gnus-level-zombie)
+ (push group gnus-zombie-list)
+ (push group gnus-killed-list))))
+ (t
+ ;; If the list is to be entered into the newsrc assoc, and
+ ;; it was killed, we have to create an entry in the newsrc
+ ;; hashtb format and fix the pointers in the newsrc assoc.
+ (if (< oldlevel gnus-level-zombie)
+ ;; It was alive, and it is going to stay alive, so we
+ ;; just change the level and don't change any pointers or
+ ;; hash table entries.
+ (setcar (cdaddr entry) level)
+ (if (listp entry)
+ (setq info (cdr entry)
+ num (car entry))
+ (setq active (gnus-active group))
+ (setq num
+ (if active (- (1+ (cdr active)) (car active)) t))
+ ;; Check whether the group is foreign. If so, the
+ ;; foreign select method has to be entered into the
+ ;; info.
+ (let ((method (or gnus-override-subscribe-method
+ (gnus-group-method group))))
+ (if (eq method gnus-select-method)
+ (setq info (list group level nil))
+ (setq info (list group level nil nil method)))))
+ (unless previous
+ (setq previous
+ (let ((p gnus-newsrc-alist))
+ (while (cddr p)
+ (setq p (cdr p)))
+ p)))
+ (setq entry (cons info (cddr previous)))
+ (if (cdr previous)
+ (progn
+ (setcdr (cdr previous) entry)
+ (gnus-sethash group (cons num (cdr previous))
+ gnus-newsrc-hashtb))
+ (setcdr previous entry)
+ (gnus-sethash group (cons num previous)
+ gnus-newsrc-hashtb))
+ (when (cdr entry)
+ (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))
+ (gnus-dribble-enter
+ (format
+ "(gnus-group-set-info '%S)" info)))))
+ (when gnus-group-change-level-function
+ (funcall gnus-group-change-level-function
+ group level oldlevel previous)))))
+
+(defun gnus-kill-newsgroup (newsgroup)
+ "Obsolete function. Kills a newsgroup."
+ (gnus-group-change-level
+ (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
+
+(defun gnus-check-bogus-newsgroups (&optional confirm)
+ "Remove bogus newsgroups.
+If CONFIRM is non-nil, the user has to confirm the deletion of every
+newsgroup."
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ bogus group entry info)
+ (gnus-message 5 "Checking bogus newsgroups...")
+ (unless (gnus-read-active-file-p)
+ (gnus-read-active-file t))
+ (when (gnus-read-active-file-p)
+ ;; Find all bogus newsgroup that are subscribed.
+ (while newsrc
+ (setq info (pop newsrc)
+ group (gnus-info-group info))
+ (unless (or (gnus-active group) ; Active
+ (gnus-info-method info)) ; Foreign
+ ;; Found a bogus newsgroup.
+ (push group bogus)))
+ (if confirm
+ (map-y-or-n-p
+ "Remove bogus group %s? "
+ (lambda (group)
+ ;; Remove all bogus subscribed groups by first killing them, and
+ ;; then removing them from the list of killed groups.
+ (when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
+ (gnus-group-change-level entry gnus-level-killed)
+ (setq gnus-killed-list (delete group gnus-killed-list))))
+ bogus '("group" "groups" "remove"))
+ (while (setq group (pop bogus))
+ ;; Remove all bogus subscribed groups by first killing them, and
+ ;; then removing them from the list of killed groups.
+ (when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
+ (gnus-group-change-level entry gnus-level-killed)
+ (setq gnus-killed-list (delete group gnus-killed-list)))))
+ ;; Then we remove all bogus groups from the list of killed and
+ ;; zombie groups. They are removed without confirmation.
+ (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
+ killed)
+ (while dead-lists
+ (setq killed (symbol-value (car dead-lists)))
+ (while killed
+ (unless (gnus-active (setq group (pop killed)))
+ ;; The group is bogus.
+ ;; !!!Slow as hell.
+ (set (car dead-lists)
+ (delete group (symbol-value (car dead-lists))))))
+ (setq dead-lists (cdr dead-lists))))
+ (run-hooks 'gnus-check-bogus-groups-hook)
+ (gnus-message 5 "Checking bogus newsgroups...done"))))
+
+(defun gnus-check-duplicate-killed-groups ()
+ "Remove duplicates from the list of killed groups."
+ (interactive)
+ (let ((killed gnus-killed-list))
+ (while killed
+ (gnus-message 9 "%d" (length killed))
+ (setcdr killed (delete (car killed) (cdr killed)))
+ (setq killed (cdr killed)))))
+
+;; We want to inline a function from gnus-cache, so we cheat here:
+(eval-when-compile
+ (defvar gnus-cache-active-hashtb)
+ (defun gnus-cache-possibly-alter-active (group active)
+ "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
+ (when gnus-cache-active-hashtb
+ (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
+ (when cache-active
+ (when (< (car cache-active) (car active))
+ (setcar active (car cache-active)))
+ (when (> (cdr cache-active) (cdr active))
+ (setcdr active (cdr cache-active))))))))
+
+(defun gnus-activate-group (group &optional scan dont-check method)
+ ;; Check whether a group has been activated or not.
+ ;; If SCAN, request a scan of that group as well.
+ (let ((method (or method (inline (gnus-find-method-for-group group))))
+ active)
+ (and (inline (gnus-check-server method))
+ ;; We escape all bugs and quit here to make it possible to
+ ;; continue if a group is so out-there that it reports bugs
+ ;; and stuff.
+ (progn
+ (and scan
+ (gnus-check-backend-function 'request-scan (car method))
+ (gnus-request-scan group method))
+ t)
+ (condition-case ()
+ (inline (gnus-request-group group dont-check method))
+ (error nil)
+ (quit nil))
+ (setq active (gnus-parse-active))
+ ;; If there are no articles in the group, the GROUP
+ ;; command may have responded with the `(0 . 0)'. We
+ ;; ignore this if we already have an active entry
+ ;; for the group.
+ (if (and (zerop (car active))
+ (zerop (cdr active))
+ (gnus-active group))
+ (gnus-active group)
+ (gnus-set-active group active)
+ ;; Return the new active info.
+ active))))
+
+(defun gnus-get-unread-articles-in-group (info active &optional update)
+ (when active
+ ;; Allow the backend to update the info in the group.
+ (when (and update
+ (gnus-request-update-info
+ info (inline (gnus-find-method-for-group
+ (gnus-info-group info)))))
+ (gnus-activate-group (gnus-info-group info) nil t))
+ (let* ((range (gnus-info-read info))
+ (num 0))
+ ;; If a cache is present, we may have to alter the active info.
+ (when (and gnus-use-cache info)
+ (inline (gnus-cache-possibly-alter-active
+ (gnus-info-group info) active)))
+ ;; Modify the list of read articles according to what articles
+ ;; are available; then tally the unread articles and add the
+ ;; number to the group hash table entry.
+ (cond
+ ((zerop (cdr active))
+ (setq num 0))
+ ((not range)
+ (setq num (- (1+ (cdr active)) (car active))))
+ ((not (listp (cdr range)))
+ ;; Fix a single (num . num) range according to the
+ ;; active hash table.
+ ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
+ (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
+ (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
+ ;; Compute number of unread articles.
+ (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
+ (t
+ ;; The read list is a list of ranges. Fix them according to
+ ;; the active hash table.
+ ;; First peel off any elements that are below the lower
+ ;; active limit.
+ (while (and (cdr range)
+ (>= (car active)
+ (or (and (atom (cadr range)) (cadr range))
+ (caadr range))))
+ (if (numberp (car range))
+ (setcar range
+ (cons (car range)
+ (or (and (numberp (cadr range))
+ (cadr range))
+ (cdadr range))))
+ (setcdr (car range)
+ (or (and (numberp (nth 1 range)) (nth 1 range))
+ (cdadr range))))
+ (setcdr range (cddr range)))
+ ;; Adjust the first element to be the same as the lower limit.
+ (when (and (not (atom (car range)))
+ (< (cdar range) (car active)))
+ (setcdr (car range) (1- (car active))))
+ ;; Then we want to peel off any elements that are higher
+ ;; than the upper active limit.
+ (let ((srange range))
+ ;; Go past all legal elements.
+ (while (and (cdr srange)
+ (<= (or (and (atom (cadr srange))
+ (cadr srange))
+ (caadr srange))
+ (cdr active)))
+ (setq srange (cdr srange)))
+ (when (cdr srange)
+ ;; Nuke all remaining illegal elements.
+ (setcdr srange nil))
+
+ ;; Adjust the final element.
+ (when (and (not (atom (car srange)))
+ (> (cdar srange) (cdr active)))
+ (setcdr (car srange) (cdr active))))
+ ;; Compute the number of unread articles.
+ (while range
+ (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
+ (cdar range)))
+ (or (and (atom (car range)) (car range))
+ (caar range)))))
+ (setq range (cdr range)))
+ (setq num (max 0 (- (cdr active) num)))))
+ ;; Set the number of unread articles.
+ (when info
+ (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
+ num)))
+
+;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
+;; and compute how many unread articles there are in each group.
+(defun gnus-get-unread-articles (&optional level)
+ (let* ((newsrc (cdr gnus-newsrc-alist))
+ (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
+ (foreign-level
+ (min
+ (cond ((and gnus-activate-foreign-newsgroups
+ (not (numberp gnus-activate-foreign-newsgroups)))
+ (1+ gnus-level-subscribed))
+ ((numberp gnus-activate-foreign-newsgroups)
+ gnus-activate-foreign-newsgroups)
+ (t 0))
+ level))
+ info group active method)
+ (gnus-message 5 "Checking new news...")
+
+ (while newsrc
+ (setq active (gnus-active (setq group (gnus-info-group
+ (setq info (pop newsrc))))))
+
+ ;; Check newsgroups. If the user doesn't want to check them, or
+ ;; they can't be checked (for instance, if the news server can't
+ ;; be reached) we just set the number of unread articles in this
+ ;; newsgroup to t. This means that Gnus thinks that there are
+ ;; unread articles, but it has no idea how many.
+ (if (and (setq method (gnus-info-method info))
+ (not (inline
+ (gnus-server-equal
+ gnus-select-method
+ (setq method (gnus-server-get-method nil method)))))
+ (not (gnus-secondary-method-p method)))
+ ;; These groups are foreign. Check the level.
+ (when (<= (gnus-info-level info) foreign-level)
+ (setq active (gnus-activate-group group 'scan))
+ (unless (inline (gnus-virtual-group-p group))
+ (inline (gnus-close-group group)))
+ (when (fboundp (intern (concat (symbol-name (car method))
+ "-request-update-info")))
+ (inline (gnus-request-update-info info method))))
+ ;; These groups are native or secondary.
+ (when (and (<= (gnus-info-level info) level)
+ (not gnus-read-active-file))
+ (setq active (gnus-activate-group group 'scan))
+ (inline (gnus-close-group group))))
+
+ ;; Get the number of unread articles in the group.
+ (if active
+ (inline (gnus-get-unread-articles-in-group info active t))
+ ;; The group couldn't be reached, so we nix out the number of
+ ;; unread articles and stuff.
+ (gnus-set-active group nil)
+ (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
+
+ (gnus-message 5 "Checking new news...done")))
+
+;; Create a hash table out of the newsrc alist. The `car's of the
+;; alist elements are used as keys.
+(defun gnus-make-hashtable-from-newsrc-alist ()
+ (let ((alist gnus-newsrc-alist)
+ (ohashtb gnus-newsrc-hashtb)
+ prev)
+ (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
+ (setq alist
+ (setq prev (setq gnus-newsrc-alist
+ (if (equal (caar gnus-newsrc-alist)
+ "dummy.group")
+ gnus-newsrc-alist
+ (cons (list "dummy.group" 0 nil) alist)))))
+ (while alist
+ (gnus-sethash
+ (caar alist)
+ ;; Preserve number of unread articles in groups.
+ (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
+ prev)
+ gnus-newsrc-hashtb)
+ (setq prev alist
+ alist (cdr alist)))))
+
+(defun gnus-make-hashtable-from-killed ()
+ "Create a hash table from the killed and zombie lists."
+ (let ((lists '(gnus-killed-list gnus-zombie-list))
+ list)
+ (setq gnus-killed-hashtb
+ (gnus-make-hashtable
+ (+ (length gnus-killed-list) (length gnus-zombie-list))))
+ (while lists
+ (setq list (symbol-value (pop lists)))
+ (while list
+ (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
+
+(defun gnus-parse-active ()
+ "Parse active info in the nntp server buffer."
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ ;; Parse the result we got from `gnus-request-group'.
+ (when (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
+ (goto-char (match-beginning 1))
+ (cons (read (current-buffer))
+ (read (current-buffer))))))
+
+(defun gnus-make-articles-unread (group articles)
+ "Mark ARTICLES in GROUP as unread."
+ (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
+ (gnus-gethash (gnus-group-real-name group)
+ gnus-newsrc-hashtb))))
+ (ranges (gnus-info-read info))
+ news article)
+ (while articles
+ (when (gnus-member-of-range
+ (setq article (pop articles)) ranges)
+ (push article news)))
+ (when news
+ (gnus-info-set-read
+ info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
+ (gnus-group-update-group group t))))
+
+;; Enter all dead groups into the hashtb.
+(defun gnus-update-active-hashtb-from-killed ()
+ (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
+ (lists (list gnus-killed-list gnus-zombie-list))
+ killed)
+ (while lists
+ (setq killed (car lists))
+ (while killed
+ (gnus-sethash (car killed) nil hashtb)
+ (setq killed (cdr killed)))
+ (setq lists (cdr lists)))))
+
+(defun gnus-get-killed-groups ()
+ "Go through the active hashtb and mark all unknown groups as killed."
+ ;; First make sure active file has been read.
+ (unless (gnus-read-active-file-p)
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file)))
+ (unless gnus-killed-hashtb
+ (gnus-make-hashtable-from-killed))
+ ;; Go through all newsgroups that are known to Gnus - enlarge kill list.
+ (mapatoms
+ (lambda (sym)
+ (let ((groups 0)
+ (group (symbol-name sym)))
+ (if (or (null group)
+ (gnus-gethash group gnus-killed-hashtb)
+ (gnus-gethash group gnus-newsrc-hashtb))
+ ()
+ (let ((do-sub (gnus-matches-options-n group)))
+ (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
+ ()
+ (setq groups (1+ groups))
+ (push group gnus-killed-list)
+ (gnus-sethash group group gnus-killed-hashtb))))))
+ gnus-active-hashtb)
+ (gnus-dribble-touch))
+
+;; Get the active file(s) from the backend(s).
+(defun gnus-read-active-file (&optional force not-native)
+ (gnus-group-set-mode-line)
+ (let ((methods
+ (append
+ (if (and (not not-native)
+ (gnus-check-server gnus-select-method))
+ ;; The native server is available.
+ (cons gnus-select-method gnus-secondary-select-methods)
+ ;; The native server is down, so we just do the
+ ;; secondary ones.
+ gnus-secondary-select-methods)
+ ;; Also read from the archive server.
+ (when (gnus-archive-server-wanted-p)
+ (list "archive"))))
+ list-type)
+ (setq gnus-have-read-active-file nil)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (while methods
+ (let* ((method (if (stringp (car methods))
+ (gnus-server-get-method nil (car methods))
+ (car methods)))
+ (where (nth 1 method))
+ (mesg (format "Reading active file%s via %s..."
+ (if (and where (not (zerop (length where))))
+ (concat " from " where) "")
+ (car method))))
+ (gnus-message 5 mesg)
+ (when (gnus-check-server method)
+ ;; Request that the backend scan its incoming messages.
+ (when (gnus-check-backend-function 'request-scan (car method))
+ (gnus-request-scan nil method))
+ (cond
+ ((and (eq gnus-read-active-file 'some)
+ (gnus-check-backend-function 'retrieve-groups (car method))
+ (not force))
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ (gmethod (gnus-server-get-method nil method))
+ groups info)
+ (while (setq info (pop newsrc))
+ (when (inline
+ (gnus-server-equal
+ (inline
+ (gnus-find-method-for-group
+ (gnus-info-group info) info))
+ gmethod))
+ (push (gnus-group-real-name (gnus-info-group info))
+ groups)))
+ (when groups
+ (gnus-check-server method)
+ (setq list-type (gnus-retrieve-groups groups method))
+ (cond
+ ((not list-type)
+ (gnus-error
+ 1.2 "Cannot read partial active file from %s server."
+ (car method)))
+ ((eq list-type 'active)
+ (gnus-active-to-gnus-format
+ method gnus-active-hashtb nil t))
+ (t
+ (gnus-groups-to-gnus-format
+ method gnus-active-hashtb t))))))
+ ((null method)
+ t)
+ (t
+ (if (not (gnus-request-list method))
+ (unless (equal method gnus-message-archive-method)
+ (gnus-error 1 "Cannot read active file from %s server"
+ (car method)))
+ (gnus-message 5 mesg)
+ (gnus-active-to-gnus-format method gnus-active-hashtb nil t)
+ ;; We mark this active file as read.
+ (push method gnus-have-read-active-file)
+ (gnus-message 5 "%sdone" mesg))))))
+ (setq methods (cdr methods))))))
+
+
+(defun gnus-ignored-newsgroups-has-to-p ()
+ "T only when gnus-ignored-newsgroups includes \"^to\\\\.\" as an element."
+ ;; note this regexp is the same as:
+ ;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)")
+ (string-match "\\^to\\\\\\.\\($\\|\\\\|\\)"
+ gnus-ignored-newsgroups))
+
+;; Read an active file and place the results in `gnus-active-hashtb'.
+(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors
+ real-active)
+ (unless method
+ (setq method gnus-select-method))
+ (let ((cur (current-buffer))
+ (hashtb (or hashtb
+ (if (and gnus-active-hashtb
+ (not (equal method gnus-select-method)))
+ gnus-active-hashtb
+ (setq gnus-active-hashtb
+ (if (equal method gnus-select-method)
+ (gnus-make-hashtable
+ (count-lines (point-min) (point-max)))
+ (gnus-make-hashtable 4096)))))))
+ ;; Delete unnecessary lines.
+ (goto-char (point-min))
+ (cond ((gnus-ignored-newsgroups-has-to-p)
+ (delete-matching-lines gnus-ignored-newsgroups))
+ ((string= gnus-ignored-newsgroups "")
+ (delete-matching-lines "^to\\."))
+ (t
+ (delete-matching-lines (concat "^to\\.\\|"
+ gnus-ignored-newsgroups))))
+
+ ;; Make the group names readable as a lisp expression even if they
+ ;; contain special characters.
+ (goto-char (point-max))
+ (while (re-search-backward "[][';?()#]" nil t)
+ (insert ?\\))
+
+ ;; Let the Gnus agent save the active file.
+ (when (and gnus-agent real-active)
+ (gnus-agent-save-active method))
+
+ ;; If these are groups from a foreign select method, we insert the
+ ;; group prefix in front of the group names.
+ (when (not (gnus-server-equal
+ (gnus-server-get-method nil method)
+ (gnus-server-get-method nil gnus-select-method)))
+ (let ((prefix (gnus-group-prefixed-name "" method)))
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (progn (insert prefix)
+ (zerop (forward-line 1)))))))
+ ;; Store the active file in a hash table.
+ (goto-char (point-min))
+ (let (group max min)
+ (while (not (eobp))
+ (condition-case ()
+ (progn
+ (narrow-to-region (point) (gnus-point-at-eol))
+ ;; group gets set to a symbol interned in the hash table
+ ;; (what a hack!!) - jwz
+ (setq group (let ((obarray hashtb)) (read cur)))
+ (if (and (numberp (setq max (read cur)))
+ (numberp (setq min (read cur)))
+ (progn
+ (skip-chars-forward " \t")
+ (not
+ (or (= (following-char) ?=)
+ (= (following-char) ?x)
+ (= (following-char) ?j)))))
+ (progn
+ (set group (cons min max))
+ ;; if group is moderated, stick in moderation table
+ (when (= (following-char) ?m)
+ (unless gnus-moderated-hashtb
+ (setq gnus-moderated-hashtb (gnus-make-hashtable)))
+ (gnus-sethash (symbol-name group) t
+ gnus-moderated-hashtb)))
+ (set group nil)))
+ (error
+ (and group
+ (symbolp group)
+ (set group nil))
+ (unless ignore-errors
+ (gnus-message 3 "Warning - illegal active: %s"
+ (buffer-substring
+ (gnus-point-at-bol) (gnus-point-at-eol))))))
+ (widen)
+ (forward-line 1)))))
+
+(defun gnus-groups-to-gnus-format (method &optional hashtb real-active)
+ ;; Parse a "groups" active file.
+ (let ((cur (current-buffer))
+ (hashtb (or hashtb
+ (if (and method gnus-active-hashtb)
+ gnus-active-hashtb
+ (setq gnus-active-hashtb
+ (gnus-make-hashtable
+ (count-lines (point-min) (point-max)))))))
+ (prefix (and method
+ (not (gnus-server-equal
+ (gnus-server-get-method nil method)
+ (gnus-server-get-method nil gnus-select-method)))
+ (gnus-group-prefixed-name "" method))))
+
+ ;; Let the Gnus agent save the active file.
+ (when (and gnus-agent real-active)
+ (gnus-agent-save-groups method))
+
+ (goto-char (point-min))
+ ;; We split this into to separate loops, one with the prefix
+ ;; and one without to speed the reading up somewhat.
+ (if prefix
+ (let (min max opoint group)
+ (while (not (eobp))
+ (condition-case ()
+ (progn
+ (read cur) (read cur)
+ (setq min (read cur)
+ max (read cur)
+ opoint (point))
+ (skip-chars-forward " \t")
+ (insert prefix)
+ (goto-char opoint)
+ (set (let ((obarray hashtb)) (read cur))
+ (cons min max)))
+ (error (and group (symbolp group) (set group nil))))
+ (forward-line 1)))
+ (let (min max group)
+ (while (not (eobp))
+ (condition-case ()
+ (when (= (following-char) ?2)
+ (read cur) (read cur)
+ (setq min (read cur)
+ max (read cur))
+ (set (setq group (let ((obarray hashtb)) (read cur)))
+ (cons min max)))
+ (error (and group (symbolp group) (set group nil))))
+ (forward-line 1))))))
+
+(defun gnus-read-newsrc-file (&optional force)
+ "Read startup file.
+If FORCE is non-nil, the .newsrc file is read."
+ ;; Reset variables that might be defined in the .newsrc.eld file.
+ (let ((variables gnus-variable-list))
+ (while variables
+ (set (car variables) nil)
+ (setq variables (cdr variables))))
+ (let* ((newsrc-file gnus-current-startup-file)
+ (quick-file (concat newsrc-file ".el")))
+ (save-excursion
+ ;; We always load the .newsrc.eld file. If always contains
+ ;; much information that can not be gotten from the .newsrc
+ ;; file (ticked articles, killed groups, foreign methods, etc.)
+ (gnus-read-newsrc-el-file quick-file)
+
+ (when (and (file-exists-p gnus-current-startup-file)
+ (or force
+ (and (file-newer-than-file-p newsrc-file quick-file)
+ (file-newer-than-file-p newsrc-file
+ (concat quick-file "d")))
+ (not gnus-newsrc-alist)))
+ ;; We read the .newsrc file. Note that if there if a
+ ;; .newsrc.eld file exists, it has already been read, and
+ ;; the `gnus-newsrc-hashtb' has been created. While reading
+ ;; the .newsrc file, Gnus will only use the information it
+ ;; can find there for changing the data already read -
+ ;; i. e., reading the .newsrc file will not trash the data
+ ;; already read (except for read articles).
+ (save-excursion
+ (gnus-message 5 "Reading %s..." newsrc-file)
+ (set-buffer (nnheader-find-file-noselect newsrc-file))
+ (buffer-disable-undo (current-buffer))
+ (gnus-newsrc-to-gnus-format)
+ (kill-buffer (current-buffer))
+ (gnus-message 5 "Reading %s...done" newsrc-file)))
+
+ ;; Convert old to new.
+ (gnus-convert-old-newsrc))))
+
+(defun gnus-convert-old-newsrc ()
+ "Convert old newsrc into the new format, if needed."
+ (let ((fcv (and gnus-newsrc-file-version
+ (gnus-continuum-version gnus-newsrc-file-version))))
+ (cond
+ ;; No .newsrc.eld file was loaded.
+ ((null fcv) nil)
+ ;; Gnus 5 .newsrc.eld was loaded.
+ ((< fcv (gnus-continuum-version "September Gnus v0.1"))
+ (gnus-convert-old-ticks)))))
+
+(defun gnus-convert-old-ticks ()
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ marks info dormant ticked)
+ (while (setq info (pop newsrc))
+ (when (setq marks (gnus-info-marks info))
+ (setq dormant (cdr (assq 'dormant marks))
+ ticked (cdr (assq 'tick marks)))
+ (when (or dormant ticked)
+ (gnus-info-set-read
+ info
+ (gnus-add-to-range
+ (gnus-info-read info)
+ (nconc (gnus-uncompress-range dormant)
+ (gnus-uncompress-range ticked)))))))))
+
+(defun gnus-read-newsrc-el-file (file)
+ (let ((ding-file (concat file "d")))
+ ;; We always, always read the .eld file.
+ (gnus-message 5 "Reading %s..." ding-file)
+ (let (gnus-newsrc-assoc)
+ (condition-case nil
+ (load ding-file t t t)
+ (error
+ (ding)
+ (unless (gnus-yes-or-no-p
+ (format "Error in %s; continue? " ding-file))
+ (error "Error in %s" ding-file))))
+ (when gnus-newsrc-assoc
+ (setq gnus-newsrc-alist gnus-newsrc-assoc)))
+ (gnus-make-hashtable-from-newsrc-alist)
+ (when (file-newer-than-file-p file ding-file)
+ ;; Old format quick file
+ (gnus-message 5 "Reading %s..." file)
+ ;; The .el file is newer than the .eld file, so we read that one
+ ;; as well.
+ (gnus-read-old-newsrc-el-file file))))
+
+;; Parse the old-style quick startup file
+(defun gnus-read-old-newsrc-el-file (file)
+ (let (newsrc killed marked group m info)
+ (prog1
+ (let ((gnus-killed-assoc nil)
+ gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
+ (prog1
+ (ignore-errors
+ (load file t t t))
+ (setq newsrc gnus-newsrc-assoc
+ killed gnus-killed-assoc
+ marked gnus-marked-assoc)))
+ (setq gnus-newsrc-alist nil)
+ (while (setq group (pop newsrc))
+ (if (setq info (gnus-get-info (car group)))
+ (progn
+ (gnus-info-set-read info (cddr group))
+ (gnus-info-set-level
+ info (if (nth 1 group) gnus-level-default-subscribed
+ gnus-level-default-unsubscribed))
+ (push info gnus-newsrc-alist))
+ (push (setq info
+ (list (car group)
+ (if (nth 1 group) gnus-level-default-subscribed
+ gnus-level-default-unsubscribed)
+ (cddr group)))
+ gnus-newsrc-alist))
+ ;; Copy marks into info.
+ (when (setq m (assoc (car group) marked))
+ (unless (nthcdr 3 info)
+ (nconc info (list nil)))
+ (gnus-info-set-marks
+ info (list (cons 'tick (gnus-compress-sequence
+ (sort (cdr m) '<) t))))))
+ (setq newsrc killed)
+ (while newsrc
+ (setcar newsrc (caar newsrc))
+ (setq newsrc (cdr newsrc)))
+ (setq gnus-killed-list killed))
+ ;; The .el file version of this variable does not begin with
+ ;; "options", while the .eld version does, so we just add it if it
+ ;; isn't there.
+ (when
+ gnus-newsrc-options
+ (when (not (string-match "^ *options" gnus-newsrc-options))
+ (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
+ (when (not (string-match "\n$" gnus-newsrc-options))
+ (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
+ ;; Finally, if we read some options lines, we parse them.
+ (unless (string= gnus-newsrc-options "")
+ (gnus-newsrc-parse-options gnus-newsrc-options)))
+
+ (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
+ (gnus-make-hashtable-from-newsrc-alist)))
+
+(defun gnus-make-newsrc-file (file)
+ "Make server dependent file name by catenating FILE and server host name."
+ (let* ((file (expand-file-name file nil))
+ (real-file (concat file "-" (nth 1 gnus-select-method))))
+ (if (or (file-exists-p real-file)
+ (file-exists-p (concat real-file ".el"))
+ (file-exists-p (concat real-file ".eld")))
+ real-file file)))
+
+(defun gnus-newsrc-to-gnus-format ()
+ (setq gnus-newsrc-options "")
+ (setq gnus-newsrc-options-n nil)
+
+ (unless gnus-active-hashtb
+ (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
+ (let ((buf (current-buffer))
+ (already-read (> (length gnus-newsrc-alist) 1))
+ group subscribed options-symbol newsrc Options-symbol
+ symbol reads num1)
+ (goto-char (point-min))
+ ;; We intern the symbol `options' in the active hashtb so that we
+ ;; can `eq' against it later.
+ (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
+ (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
+
+ (while (not (eobp))
+ ;; We first read the first word on the line by narrowing and
+ ;; then reading into `gnus-active-hashtb'. Most groups will
+ ;; already exist in that hashtb, so this will save some string
+ ;; space.
+ (narrow-to-region
+ (point)
+ (progn (skip-chars-forward "^ \t!:\n") (point)))
+ (goto-char (point-min))
+ (setq symbol
+ (and (/= (point-min) (point-max))
+ (let ((obarray gnus-active-hashtb)) (read buf))))
+ (widen)
+ ;; Now, the symbol we have read is either `options' or a group
+ ;; name. If it is an options line, we just add it to a string.
+ (cond
+ ((or (eq symbol options-symbol)
+ (eq symbol Options-symbol))
+ (setq gnus-newsrc-options
+ ;; This concating is quite inefficient, but since our
+ ;; thorough studies show that approx 99.37% of all
+ ;; .newsrc files only contain a single options line, we
+ ;; don't give a damn, frankly, my dear.
+ (concat gnus-newsrc-options
+ (buffer-substring
+ (gnus-point-at-bol)
+ ;; Options may continue on the next line.
+ (or (and (re-search-forward "^[^ \t]" nil 'move)
+ (progn (beginning-of-line) (point)))
+ (point)))))
+ (forward-line -1))
+ (symbol
+ ;; Group names can be just numbers.
+ (when (numberp symbol)
+ (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
+ (unless (boundp symbol)
+ (set symbol nil))
+ ;; It was a group name.
+ (setq subscribed (= (following-char) ?:)
+ group (symbol-name symbol)
+ reads nil)
+ (if (eolp)
+ ;; If the line ends here, this is clearly a buggy line, so
+ ;; we put point a the beginning of line and let the cond
+ ;; below do the error handling.
+ (beginning-of-line)
+ ;; We skip to the beginning of the ranges.
+ (skip-chars-forward "!: \t"))
+ ;; We are now at the beginning of the list of read articles.
+ ;; We read them range by range.
+ (while
+ (cond
+ ((looking-at "[0-9]+")
+ ;; We narrow and read a number instead of buffer-substring/
+ ;; string-to-int because it's faster. narrow/widen is
+ ;; faster than save-restriction/narrow, and save-restriction
+ ;; produces a garbage object.
+ (setq num1 (progn
+ (narrow-to-region (match-beginning 0) (match-end 0))
+ (read buf)))
+ (widen)
+ ;; If the next character is a dash, then this is a range.
+ (if (= (following-char) ?-)
+ (progn
+ ;; We read the upper bound of the range.
+ (forward-char 1)
+ (if (not (looking-at "[0-9]+"))
+ ;; This is a buggy line, by we pretend that
+ ;; it's kinda OK. Perhaps the user should be
+ ;; dinged?
+ (push num1 reads)
+ (push
+ (cons num1
+ (progn
+ (narrow-to-region (match-beginning 0)
+ (match-end 0))
+ (read buf)))
+ reads)
+ (widen)))
+ ;; It was just a simple number, so we add it to the
+ ;; list of ranges.
+ (push num1 reads))
+ ;; If the next char in ?\n, then we have reached the end
+ ;; of the line and return nil.
+ (/= (following-char) ?\n))
+ ((= (following-char) ?\n)
+ ;; End of line, so we end.
+ nil)
+ (t
+ ;; Not numbers and not eol, so this might be a buggy
+ ;; line...
+ (unless (eobp)
+ ;; If it was eob instead of ?\n, we allow it.
+ ;; The line was buggy.
+ (setq group nil)
+ (gnus-error 3.1 "Mangled line: %s"
+ (buffer-substring (gnus-point-at-bol)
+ (gnus-point-at-eol))))
+ nil))
+ ;; Skip past ", ". Spaces are illegal in these ranges, but
+ ;; we allow them, because it's a common mistake to put a
+ ;; space after the comma.
+ (skip-chars-forward ", "))
+
+ ;; We have already read .newsrc.eld, so we gently update the
+ ;; data in the hash table with the information we have just
+ ;; read.
+ (when group
+ (let ((info (gnus-get-info group))
+ level)
+ (if info
+ ;; There is an entry for this file in the alist.
+ (progn
+ (gnus-info-set-read info (nreverse reads))
+ ;; We update the level very gently. In fact, we
+ ;; only change it if there's been a status change
+ ;; from subscribed to unsubscribed, or vice versa.
+ (setq level (gnus-info-level info))
+ (cond ((and (<= level gnus-level-subscribed)
+ (not subscribed))
+ (setq level (if reads
+ gnus-level-default-unsubscribed
+ (1+ gnus-level-default-unsubscribed))))
+ ((and (> level gnus-level-subscribed) subscribed)
+ (setq level gnus-level-default-subscribed)))
+ (gnus-info-set-level info level))
+ ;; This is a new group.
+ (setq info (list group
+ (if subscribed
+ gnus-level-default-subscribed
+ (if reads
+ (1+ gnus-level-subscribed)
+ gnus-level-default-unsubscribed))
+ (nreverse reads))))
+ (push info newsrc)))))
+ (forward-line 1))
+
+ (setq newsrc (nreverse newsrc))
+
+ (if (not already-read)
+ ()
+ ;; We now have two newsrc lists - `newsrc', which is what we
+ ;; have read from .newsrc, and `gnus-newsrc-alist', which is
+ ;; what we've read from .newsrc.eld. We have to merge these
+ ;; lists. We do this by "attaching" any (foreign) groups in the
+ ;; gnus-newsrc-alist to the (native) group that precedes them.
+ (let ((rc (cdr gnus-newsrc-alist))
+ (prev gnus-newsrc-alist)
+ entry mentry)
+ (while rc
+ (or (null (nth 4 (car rc))) ; It's a native group.
+ (assoc (caar rc) newsrc) ; It's already in the alist.
+ (if (setq entry (assoc (caar prev) newsrc))
+ (setcdr (setq mentry (memq entry newsrc))
+ (cons (car rc) (cdr mentry)))
+ (push (car rc) newsrc)))
+ (setq prev rc
+ rc (cdr rc)))))
+
+ (setq gnus-newsrc-alist newsrc)
+ ;; We make the newsrc hashtb.
+ (gnus-make-hashtable-from-newsrc-alist)
+
+ ;; Finally, if we read some options lines, we parse them.
+ (unless (string= gnus-newsrc-options "")
+ (gnus-newsrc-parse-options gnus-newsrc-options))))
+
+;; Parse options lines to find "options -n !all rec.all" and stuff.
+;; The return value will be a list on the form
+;; ((regexp1 . ignore)
+;; (regexp2 . subscribe)...)
+;; When handling new newsgroups, groups that match a `ignore' regexp
+;; will be ignored, and groups that match a `subscribe' regexp will be
+;; subscribed. A line like
+;; options -n !all rec.all
+;; will lead to a list that looks like
+;; (("^rec\\..+" . subscribe)
+;; ("^.+" . ignore))
+;; So all "rec.*" groups will be subscribed, while all the other
+;; groups will be ignored. Note that "options -n !all rec.all" is very
+;; different from "options -n rec.all !all".
+(defun gnus-newsrc-parse-options (options)
+ (let (out eol)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert (regexp-quote options))
+ ;; First we treat all continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\n[ \t]+" nil t)
+ (replace-match " " t t))
+ ;; Then we transform all "all"s into ".+"s.
+ (goto-char (point-min))
+ (while (re-search-forward "\\ball\\b" nil t)
+ (replace-match ".+" t t))
+ (goto-char (point-min))
+ ;; We remove all other options than the "-n" ones.
+ (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
+ (replace-match " ")
+ (forward-char -1))
+ (goto-char (point-min))
+
+ ;; We are only interested in "options -n" lines - we
+ ;; ignore the other option lines.
+ (while (re-search-forward "[ \t]-n" nil t)
+ (setq eol
+ (or (save-excursion
+ (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
+ (- (point) 2)))
+ (gnus-point-at-eol)))
+ ;; Search for all "words"...
+ (while (re-search-forward "[^ \t,\n]+" eol t)
+ (if (= (char-after (match-beginning 0)) ?!)
+ ;; If the word begins with a bang (!), this is a "not"
+ ;; spec. We put this spec (minus the bang) and the
+ ;; symbol `ignore' into the list.
+ (push (cons (concat
+ "^" (buffer-substring
+ (1+ (match-beginning 0))
+ (match-end 0)))
+ 'ignore)
+ out)
+ ;; There was no bang, so this is a "yes" spec.
+ (push (cons (concat "^" (match-string 0))
+ 'subscribe)
+ out))))
+
+ (setq gnus-newsrc-options-n out))))
+
+(defun gnus-save-newsrc-file (&optional force)
+ "Save .newsrc file."
+ ;; Note: We cannot save .newsrc file if all newsgroups are removed
+ ;; from the variable gnus-newsrc-alist.
+ (when (and (or gnus-newsrc-alist gnus-killed-list)
+ gnus-current-startup-file)
+ (save-excursion
+ (if (and (or gnus-use-dribble-file gnus-slave)
+ (not force)
+ (or (not gnus-dribble-buffer)
+ (not (buffer-name gnus-dribble-buffer))
+ (zerop (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (buffer-size)))))
+ (gnus-message 4 "(No changes need to be saved)")
+ (run-hooks 'gnus-save-newsrc-hook)
+ (if gnus-slave
+ (gnus-slave-save-newsrc)
+ ;; Save .newsrc.
+ (when gnus-save-newsrc-file
+ (gnus-message 8 "Saving %s..." gnus-current-startup-file)
+ (gnus-gnus-to-newsrc-format)
+ (gnus-message 8 "Saving %s...done" gnus-current-startup-file))
+ ;; Save .newsrc.eld.
+ (set-buffer (get-buffer-create " *Gnus-newsrc*"))
+ (make-local-variable 'version-control)
+ (setq version-control 'never)
+ (setq buffer-file-name
+ (concat gnus-current-startup-file ".eld"))
+ (setq default-directory (file-name-directory buffer-file-name))
+ (gnus-add-current-to-buffer-list)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
+ (gnus-gnus-to-quick-newsrc-format)
+ (run-hooks 'gnus-save-quick-newsrc-hook)
+ (save-buffer)
+ (kill-buffer (current-buffer))
+ (gnus-message
+ 5 "Saving %s.eld...done" gnus-current-startup-file))
+ (gnus-dribble-delete-file)
+ (gnus-group-set-mode-line)))))
+
+(defun gnus-gnus-to-quick-newsrc-format ()
+ "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
+ (let ((print-quoted t)
+ (print-escape-newlines t))
+ (insert ";; -*- emacs-lisp -*-\n")
+ (insert ";; Gnus startup file.\n")
+ (insert
+ ";; Never delete this file - touch .newsrc instead to force Gnus\n")
+ (insert ";; to read .newsrc.\n")
+ (insert "(setq gnus-newsrc-file-version "
+ (prin1-to-string gnus-version) ")\n")
+ (let* ((gnus-killed-list
+ (if (and gnus-save-killed-list
+ (stringp gnus-save-killed-list))
+ (gnus-strip-killed-list)
+ gnus-killed-list))
+ (variables
+ (if gnus-save-killed-list gnus-variable-list
+ ;; Remove the `gnus-killed-list' from the list of variables
+ ;; to be saved, if required.
+ (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
+ ;; Peel off the "dummy" group.
+ (gnus-newsrc-alist (cdr gnus-newsrc-alist))
+ variable)
+ ;; Insert the variables into the file.
+ (while variables
+ (when (and (boundp (setq variable (pop variables)))
+ (symbol-value variable))
+ (insert "(setq " (symbol-name variable) " '")
+ (gnus-prin1 (symbol-value variable))
+ (insert ")\n"))))))
+
+(defun gnus-strip-killed-list ()
+ "Return the killed list minus the groups that match `gnus-save-killed-list'."
+ (let ((list gnus-killed-list)
+ olist)
+ (while list
+ (when (string-match gnus-save-killed-list)
+ (push (car list) olist))
+ (pop list))
+ (nreverse olist)))
+
+(defun gnus-gnus-to-newsrc-format ()
+ ;; Generate and save the .newsrc file.
+ (save-excursion
+ (set-buffer (create-file-buffer gnus-current-startup-file))
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ (standard-output (current-buffer))
+ info ranges range method)
+ (setq buffer-file-name gnus-current-startup-file)
+ (setq default-directory (file-name-directory buffer-file-name))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ ;; Write options.
+ (when gnus-newsrc-options
+ (insert gnus-newsrc-options))
+ ;; Write subscribed and unsubscribed.
+ (while (setq info (pop newsrc))
+ ;; Don't write foreign groups to .newsrc.
+ (when (or (null (setq method (gnus-info-method info)))
+ (equal method "native")
+ (inline (gnus-server-equal method gnus-select-method)))
+ (insert (gnus-info-group info)
+ (if (> (gnus-info-level info) gnus-level-subscribed)
+ "!" ":"))
+ (when (setq ranges (gnus-info-read info))
+ (insert " ")
+ (if (not (listp (cdr ranges)))
+ (if (= (car ranges) (cdr ranges))
+ (princ (car ranges))
+ (princ (car ranges))
+ (insert "-")
+ (princ (cdr ranges)))
+ (while (setq range (pop ranges))
+ (if (or (atom range) (= (car range) (cdr range)))
+ (princ (or (and (atom range) range) (car range)))
+ (princ (car range))
+ (insert "-")
+ (princ (cdr range)))
+ (when ranges
+ (insert ",")))))
+ (insert "\n")))
+ (make-local-variable 'version-control)
+ (setq version-control 'never)
+ ;; It has been reported that sometime the modtime on the .newsrc
+ ;; file seems to be off. We really do want to overwrite it, so
+ ;; we clear the modtime here before saving. It's a bit odd,
+ ;; though...
+ ;; sometimes the modtime clear isn't sufficient. most brute force:
+ ;; delete the silly thing entirely first. but this fails to provide
+ ;; such niceties as .newsrc~ creation.
+ (if gnus-modtime-botch
+ (delete-file gnus-startup-file)
+ (clear-visited-file-modtime))
+ (run-hooks 'gnus-save-standard-newsrc-hook)
+ (save-buffer)
+ (kill-buffer (current-buffer)))))
+
+\f
+;;;
+;;; Slave functions.
+;;;
+
+(defun gnus-slave-save-newsrc ()
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (let ((slave-name
+ (make-temp-name (concat gnus-current-startup-file "-slave-")))
+ (modes (ignore-errors
+ (file-modes (concat gnus-current-startup-file ".eld")))))
+ (gnus-write-buffer slave-name)
+ (when modes
+ (set-file-modes slave-name modes)))))
+
+(defun gnus-master-read-slave-newsrc ()
+ (let ((slave-files
+ (directory-files
+ (file-name-directory gnus-current-startup-file)
+ t (concat
+ "^" (regexp-quote
+ (concat
+ (file-name-nondirectory gnus-current-startup-file)
+ "-slave-")))
+ t))
+ file)
+ (if (not slave-files)
+ () ; There are no slave files to read.
+ (gnus-message 7 "Reading slave newsrcs...")
+ (save-excursion
+ (set-buffer (get-buffer-create " *gnus slave*"))
+ (buffer-disable-undo (current-buffer))
+ (setq slave-files
+ (sort (mapcar (lambda (file)
+ (list (nth 5 (file-attributes file)) file))
+ slave-files)
+ (lambda (f1 f2)
+ (or (< (caar f1) (caar f2))
+ (< (nth 1 (car f1)) (nth 1 (car f2)))))))
+ (while slave-files
+ (erase-buffer)
+ (setq file (nth 1 (car slave-files)))
+ (insert-file-contents file)
+ (when (condition-case ()
+ (progn
+ (eval-buffer (current-buffer))
+ t)
+ (error
+ (gnus-error 3.2 "Possible error in %s" file)
+ nil))
+ (unless gnus-slave ; Slaves shouldn't delete these files.
+ (ignore-errors
+ (delete-file file))))
+ (setq slave-files (cdr slave-files))))
+ (gnus-dribble-touch)
+ (gnus-message 7 "Reading slave newsrcs...done"))))
+
+\f
+;;;
+;;; Group description.
+;;;
+
+(defun gnus-read-all-descriptions-files ()
+ (let ((methods (cons gnus-select-method
+ (nconc
+ (when (gnus-archive-server-wanted-p)
+ (list "archive"))
+ gnus-secondary-select-methods))))
+ (while methods
+ (gnus-read-descriptions-file (car methods))
+ (setq methods (cdr methods)))
+ t))
+
+(defun gnus-read-descriptions-file (&optional method)
+ (let ((method (or method gnus-select-method))
+ group)
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ ;; We create the hashtable whether we manage to read the desc file
+ ;; to avoid trying to re-read after a failed read.
+ (unless gnus-description-hashtb
+ (setq gnus-description-hashtb
+ (gnus-make-hashtable (length gnus-active-hashtb))))
+ ;; Mark this method's desc file as read.
+ (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
+ gnus-description-hashtb)
+
+ (gnus-message 5 "Reading descriptions file via %s..." (car method))
+ (cond
+ ((not (gnus-check-server method))
+ (gnus-message 1 "Couldn't open server")
+ nil)
+ ((not (gnus-request-list-newsgroups method))
+ (gnus-message 1 "Couldn't read newsgroups descriptions")
+ nil)
+ (t
+ (save-excursion
+ (save-restriction
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (when (or (search-forward "\n.\n" nil t)
+ (goto-char (point-max)))
+ (beginning-of-line)
+ (narrow-to-region (point-min) (point)))
+ ;; If these are groups from a foreign select method, we insert the
+ ;; group prefix in front of the group names.
+ (and method (not (inline
+ (gnus-server-equal
+ (gnus-server-get-method nil method)
+ (gnus-server-get-method
+ nil gnus-select-method))))
+ (let ((prefix (gnus-group-prefixed-name "" method)))
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (progn (insert prefix)
+ (zerop (forward-line 1)))))))
+ (goto-char (point-min))
+ (while (not (eobp))
+ ;; If we get an error, we set group to 0, which is not a
+ ;; symbol...
+ (setq group
+ (condition-case ()
+ (let ((obarray gnus-description-hashtb))
+ ;; Group is set to a symbol interned in this
+ ;; hash table.
+ (read nntp-server-buffer))
+ (error 0)))
+ (skip-chars-forward " \t")
+ ;; ... which leads to this line being effectively ignored.
+ (when (symbolp group)
+ (set group (buffer-substring
+ (point) (progn (end-of-line) (point)))))
+ (forward-line 1))))
+ (gnus-message 5 "Reading descriptions file...done")
+ t))))
+
+(defun gnus-group-get-description (group)
+ "Get the description of a group by sending XGTITLE to the server."
+ (when (gnus-request-group-description group)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
+ (match-string 1)))))
+
+;;;###autoload
+(defun gnus-declare-backend (name &rest abilities)
+ "Declare backend NAME with ABILITIES as a Gnus backend."
+ (setq gnus-valid-select-methods
+ (nconc gnus-valid-select-methods
+ (list (apply 'list name abilities)))))
+
+(defun gnus-set-default-directory ()
+ "Set the default directory in the current buffer to `gnus-default-directory'.
+If this variable is nil, don't do anything."
+ (setq default-directory
+ (if (and gnus-default-directory
+ (file-exists-p gnus-default-directory))
+ (file-name-as-directory (expand-file-name gnus-default-directory))
+ default-directory)))
+
+(provide 'gnus-start)
+
+;;; gnus-start.el ends here
--- /dev/null
+;;; gnus-sum.el --- summary mode commands for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-group)
+(require 'gnus-spec)
+(require 'gnus-range)
+(require 'gnus-int)
+(require 'gnus-undo)
+
+(defcustom gnus-kill-summary-on-exit t
+ "*If non-nil, kill the summary buffer when you exit from it.
+If nil, the summary will become a \"*Dead Summary*\" buffer, and
+it will be killed sometime later."
+ :group 'gnus-summary-exit
+ :type 'boolean)
+
+(defcustom gnus-fetch-old-headers nil
+ "*Non-nil means that Gnus will try to build threads by grabbing old headers.
+If an unread article in the group refers to an older, already read (or
+just marked as read) article, the old article will not normally be
+displayed in the Summary buffer. If this variable is non-nil, Gnus
+will attempt to grab the headers to the old articles, and thereby
+build complete threads. If it has the value `some', only enough
+headers to connect otherwise loose threads will be displayed. This
+variable can also be a number. In that case, no more than that number
+of old headers will be fetched. If it has the value `invisible', all
+old headers will be fetched, but none will be displayed.
+
+The server has to support NOV for any of this to work."
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ (const some)
+ number
+ (sexp :menu-tag "other" t)))
+
+(defcustom gnus-refer-thread-limit 200
+ "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
+If t, fetch all the available old headers."
+ :group 'gnus-thread
+ :type '(choice number
+ (sexp :menu-tag "other" t)))
+
+(defcustom gnus-summary-make-false-root 'adopt
+ "*nil means that Gnus won't gather loose threads.
+If the root of a thread has expired or been read in a previous
+session, the information necessary to build a complete thread has been
+lost. Instead of having many small sub-threads from this original thread
+scattered all over the summary buffer, Gnus can gather them.
+
+If non-nil, Gnus will try to gather all loose sub-threads from an
+original thread into one large thread.
+
+If this variable is non-nil, it should be one of `none', `adopt',
+`dummy' or `empty'.
+
+If this variable is `none', Gnus will not make a false root, but just
+present the sub-threads after another.
+If this variable is `dummy', Gnus will create a dummy root that will
+have all the sub-threads as children.
+If this variable is `adopt', Gnus will make one of the \"children\"
+the parent and mark all the step-children as such.
+If this variable is `empty', the \"children\" are printed with empty
+subject fields. (Or rather, they will be printed with a string
+given by the `gnus-summary-same-subject' variable.)"
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ (const none)
+ (const dummy)
+ (const adopt)
+ (const empty)))
+
+(defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
+ "*A regexp to match subjects to be excluded from loose thread gathering.
+As loose thread gathering is done on subjects only, that means that
+there can be many false gatherings performed. By rooting out certain
+common subjects, gathering might become saner."
+ :group 'gnus-thread
+ :type 'regexp)
+
+(defcustom gnus-summary-gather-subject-limit nil
+ "*Maximum length of subject comparisons when gathering loose threads.
+Use nil to compare full subjects. Setting this variable to a low
+number will help gather threads that have been corrupted by
+newsreaders chopping off subject lines, but it might also mean that
+unrelated articles that have subject that happen to begin with the
+same few characters will be incorrectly gathered.
+
+If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
+comparing subjects."
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ (const fuzzy)
+ (sexp :menu-tag "on" t)))
+
+(defcustom gnus-simplify-subject-functions nil
+ "List of functions taking a string argument that simplify subjects.
+The functions are applied recursively."
+ :group 'gnus-thread
+ :type '(repeat (list function)))
+
+(defcustom gnus-simplify-ignored-prefixes nil
+ "*Regexp, matches for which are removed from subject lines when simplifying fuzzily."
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ regexp))
+
+(defcustom gnus-build-sparse-threads nil
+ "*If non-nil, fill in the gaps in threads.
+If `some', only fill in the gaps that are needed to tie loose threads
+together. If `more', fill in all leaf nodes that Gnus can find. If
+non-nil and non-`some', fill in all gaps that Gnus manages to guess."
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ (const some)
+ (const more)
+ (sexp :menu-tag "all" t)))
+
+(defcustom gnus-summary-thread-gathering-function
+ 'gnus-gather-threads-by-subject
+ "Function used for gathering loose threads.
+There are two pre-defined functions: `gnus-gather-threads-by-subject',
+which only takes Subjects into consideration; and
+`gnus-gather-threads-by-references', which compared the References
+headers of the articles to find matches."
+ :group 'gnus-thread
+ :type '(radio (function-item gnus-gather-threads-by-subject)
+ (function-item gnus-gather-threads-by-references)
+ (function :tag "other")))
+
+(defcustom gnus-summary-same-subject ""
+ "*String indicating that the current article has the same subject as the previous.
+This variable will only be used if the value of
+`gnus-summary-make-false-root' is `empty'."
+ :group 'gnus-summary-format
+ :type 'string)
+
+(defcustom gnus-summary-goto-unread t
+ "*If t, marking commands will go to the next unread article.
+If `never', commands that usually go to the next unread article, will
+go to the next article, whether it is read or not.
+If nil, only the marking commands will go to the next (un)read article."
+ :group 'gnus-summary-marks
+ :link '(custom-manual "(gnus)Setting Marks")
+ :type '(choice (const :tag "off" nil)
+ (const never)
+ (sexp :menu-tag "on" t)))
+
+(defcustom gnus-summary-default-score 0
+ "*Default article score level.
+All scores generated by the score files will be added to this score.
+If this variable is nil, scoring will be disabled."
+ :group 'gnus-score-default
+ :type '(choice (const :tag "disable")
+ integer))
+
+(defcustom gnus-summary-zcore-fuzz 0
+ "*Fuzziness factor for the zcore in the summary buffer.
+Articles with scores closer than this to `gnus-summary-default-score'
+will not be marked."
+ :group 'gnus-summary-format
+ :type 'integer)
+
+(defcustom gnus-simplify-subject-fuzzy-regexp nil
+ "*Strings to be removed when doing fuzzy matches.
+This can either be a regular expression or list of regular expressions
+that will be removed from subject strings if fuzzy subject
+simplification is selected."
+ :group 'gnus-thread
+ :type '(repeat regexp))
+
+(defcustom gnus-show-threads t
+ "*If non-nil, display threads in summary mode."
+ :group 'gnus-thread
+ :type 'boolean)
+
+(defcustom gnus-thread-hide-subtree nil
+ "*If non-nil, hide all threads initially.
+If threads are hidden, you have to run the command
+`gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
+to expose hidden threads."
+ :group 'gnus-thread
+ :type 'boolean)
+
+(defcustom gnus-thread-hide-killed t
+ "*If non-nil, hide killed threads automatically."
+ :group 'gnus-thread
+ :type 'boolean)
+
+(defcustom gnus-thread-ignore-subject nil
+ "*If non-nil, ignore subjects and do all threading based on the Reference header.
+If nil, which is the default, articles that have different subjects
+from their parents will start separate threads."
+ :group 'gnus-thread
+ :type 'boolean)
+
+(defcustom gnus-thread-operation-ignore-subject t
+ "*If non-nil, subjects will be ignored when doing thread commands.
+This affects commands like `gnus-summary-kill-thread' and
+`gnus-summary-lower-thread'.
+
+If this variable is nil, articles in the same thread with different
+subjects will not be included in the operation in question. If this
+variable is `fuzzy', only articles that have subjects that are fuzzily
+equal will be included."
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ (const fuzzy)
+ (sexp :tag "on" t)))
+
+(defcustom gnus-thread-indent-level 4
+ "*Number that says how much each sub-thread should be indented."
+ :group 'gnus-thread
+ :type 'integer)
+
+(defcustom gnus-auto-extend-newsgroup t
+ "*If non-nil, extend newsgroup forward and backward when requested."
+ :group 'gnus-summary-choose
+ :type 'boolean)
+
+(defcustom gnus-auto-select-first t
+ "*If nil, don't select the first unread article when entering a group.
+If this variable is `best', select the highest-scored unread article
+in the group. If neither nil nor `best', select the first unread
+article.
+
+If you want to prevent automatic selection of the first unread article
+in some newsgroups, set the variable to nil in
+`gnus-select-group-hook'."
+ :group 'gnus-group-select
+ :type '(choice (const :tag "none" nil)
+ (const best)
+ (sexp :menu-tag "first" t)))
+
+(defcustom gnus-auto-select-next t
+ "*If non-nil, offer to go to the next group from the end of the previous.
+If the value is t and the next newsgroup is empty, Gnus will exit
+summary mode and go back to group mode. If the value is neither nil
+nor t, Gnus will select the following unread newsgroup. In
+particular, if the value is the symbol `quietly', the next unread
+newsgroup will be selected without any confirmation, and if it is
+`almost-quietly', the next group will be selected without any
+confirmation if you are located on the last article in the group.
+Finally, if this variable is `slightly-quietly', the `Z n' command
+will go to the next group without confirmation."
+ :group 'gnus-summary-maneuvering
+ :type '(choice (const :tag "off" nil)
+ (const quietly)
+ (const almost-quietly)
+ (const slightly-quietly)
+ (sexp :menu-tag "on" t)))
+
+(defcustom gnus-auto-select-same nil
+ "*If non-nil, select the next article with the same subject."
+ :group 'gnus-summary-maneuvering
+ :type 'boolean)
+
+(defcustom gnus-summary-check-current nil
+ "*If non-nil, consider the current article when moving.
+The \"unread\" movement commands will stay on the same line if the
+current article is unread."
+ :group 'gnus-summary-maneuvering
+ :type 'boolean)
+
+(defcustom gnus-auto-center-summary t
+ "*If non-nil, always center the current summary buffer.
+In particular, if `vertical' do only vertical recentering. If non-nil
+and non-`vertical', do both horizontal and vertical recentering."
+ :group 'gnus-summary-maneuvering
+ :type '(choice (const :tag "none" nil)
+ (const vertical)
+ (sexp :menu-tag "both" t)))
+
+(defcustom gnus-show-all-headers nil
+ "*If non-nil, don't hide any headers."
+ :group 'gnus-article-hiding
+ :group 'gnus-article-headers
+ :type 'boolean)
+
+(defcustom gnus-summary-ignore-duplicates nil
+ "*If non-nil, ignore articles with identical Message-ID headers."
+ :group 'gnus-summary
+ :type 'boolean)
+
+(defcustom gnus-single-article-buffer t
+ "*If non-nil, display all articles in the same buffer.
+If nil, each group will get its own article buffer."
+ :group 'gnus-article-various
+ :type 'boolean)
+
+(defcustom gnus-break-pages t
+ "*If non-nil, do page breaking on articles.
+The page delimiter is specified by the `gnus-page-delimiter'
+variable."
+ :group 'gnus-article-various
+ :type 'boolean)
+
+(defcustom gnus-show-mime nil
+ "*If non-nil, do mime processing of articles.
+The articles will simply be fed to the function given by
+`gnus-show-mime-method'."
+ :group 'gnus-article-mime
+ :type 'boolean)
+
+(defcustom gnus-move-split-methods nil
+ "*Variable used to suggest where articles are to be moved to.
+It uses the same syntax as the `gnus-split-methods' variable."
+ :group 'gnus-summary-mail
+ :type '(repeat (choice (list function)
+ (cons regexp (repeat string))
+ sexp)))
+
+(defcustom gnus-unread-mark ?
+ "*Mark used for unread articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-ticked-mark ?!
+ "*Mark used for ticked articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-dormant-mark ??
+ "*Mark used for dormant articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-del-mark ?r
+ "*Mark used for del'd articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-read-mark ?R
+ "*Mark used for read articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-expirable-mark ?E
+ "*Mark used for expirable articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-killed-mark ?K
+ "*Mark used for killed articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-souped-mark ?F
+ "*Mark used for killed articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-kill-file-mark ?X
+ "*Mark used for articles killed by kill files."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-low-score-mark ?Y
+ "*Mark used for articles with a low score."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-catchup-mark ?C
+ "*Mark used for articles that are caught up."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-replied-mark ?A
+ "*Mark used for articles that have been replied to."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-cached-mark ?*
+ "*Mark used for articles that are in the cache."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-saved-mark ?S
+ "*Mark used for articles that have been saved to."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-ancient-mark ?O
+ "*Mark used for ancient articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-sparse-mark ?Q
+ "*Mark used for sparsely reffed articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-canceled-mark ?G
+ "*Mark used for canceled articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-duplicate-mark ?M
+ "*Mark used for duplicate articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-undownloaded-mark ?@
+ "*Mark used for articles that weren't downloaded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-downloadable-mark ?%
+ "*Mark used for articles that are to be downloaded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-unsendable-mark ?=
+ "*Mark used for articles that won't be sent."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-score-over-mark ?+
+ "*Score mark used for articles with high scores."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-score-below-mark ?-
+ "*Score mark used for articles with low scores."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-empty-thread-mark ?
+ "*There is no thread under the article."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-not-empty-thread-mark ?=
+ "*There is a thread under the article."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-view-pseudo-asynchronously nil
+ "*If non-nil, Gnus will view pseudo-articles asynchronously."
+ :group 'gnus-extract-view
+ :type 'boolean)
+
+(defcustom gnus-view-pseudos nil
+ "*If `automatic', pseudo-articles will be viewed automatically.
+If `not-confirm', pseudos will be viewed automatically, and the user
+will not be asked to confirm the command."
+ :group 'gnus-extract-view
+ :type '(choice (const :tag "off" nil)
+ (const automatic)
+ (const not-confirm)))
+
+(defcustom gnus-view-pseudos-separately t
+ "*If non-nil, one pseudo-article will be created for each file to be viewed.
+If nil, all files that use the same viewing command will be given as a
+list of parameters to that command."
+ :group 'gnus-extract-view
+ :type 'boolean)
+
+(defcustom gnus-insert-pseudo-articles t
+ "*If non-nil, insert pseudo-articles when decoding articles."
+ :group 'gnus-extract-view
+ :type 'boolean)
+
+(defcustom gnus-summary-dummy-line-format
+ "* %(: :%) %S\n"
+ "*The format specification for the dummy roots in the summary buffer.
+It works along the same lines as a normal formatting string,
+with some simple extensions.
+
+%S The subject"
+ :group 'gnus-threading
+ :type 'string)
+
+(defcustom gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
+ "*The format specification for the summary mode line.
+It works along the same lines as a normal formatting string,
+with some simple extensions:
+
+%G Group name
+%p Unprefixed group name
+%A Current article number
+%V Gnus version
+%U Number of unread articles in the group
+%e Number of unselected articles in the group
+%Z A string with unread/unselected article counts
+%g Shortish group name
+%S Subject of the current article
+%u User-defined spec
+%s Current score file name
+%d Number of dormant articles
+%r Number of articles that have been marked as read in this session
+%E Number of articles expunged by the score files"
+ :group 'gnus-summary-format
+ :type 'string)
+
+(defcustom gnus-summary-mark-below 0
+ "*Mark all articles with a score below this variable as read.
+This variable is local to each summary buffer and usually set by the
+score file."
+ :group 'gnus-score-default
+ :type 'integer)
+
+(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
+ "*List of functions used for sorting articles in the summary buffer.
+This variable is only used when not using a threaded display."
+ :group 'gnus-summary-sort
+ :type '(repeat (choice (function-item gnus-article-sort-by-number)
+ (function-item gnus-article-sort-by-author)
+ (function-item gnus-article-sort-by-subject)
+ (function-item gnus-article-sort-by-date)
+ (function-item gnus-article-sort-by-score)
+ (function :tag "other"))))
+
+(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
+ "*List of functions used for sorting threads in the summary buffer.
+By default, threads are sorted by article number.
+
+Each function takes two threads and return non-nil if the first thread
+should be sorted before the other. If you use more than one function,
+the primary sort function should be the last. You should probably
+always include `gnus-thread-sort-by-number' in the list of sorting
+functions -- preferably first.
+
+Ready-made functions include `gnus-thread-sort-by-number',
+`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
+`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
+`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function')."
+ :group 'gnus-summary-sort
+ :type '(repeat (choice (function-item gnus-thread-sort-by-number)
+ (function-item gnus-thread-sort-by-author)
+ (function-item gnus-thread-sort-by-subject)
+ (function-item gnus-thread-sort-by-date)
+ (function-item gnus-thread-sort-by-score)
+ (function-item gnus-thread-sort-by-total-score)
+ (function :tag "other"))))
+
+(defcustom gnus-thread-score-function '+
+ "*Function used for calculating the total score of a thread.
+
+The function is called with the scores of the article and each
+subthread and should then return the score of the thread.
+
+Some functions you can use are `+', `max', or `min'."
+ :group 'gnus-summary-sort
+ :type 'function)
+
+(defcustom gnus-summary-expunge-below nil
+ "All articles that have a score less than this variable will be expunged."
+ :group 'gnus-score-default
+ :type '(choice (const :tag "off" nil)
+ integer))
+
+(defcustom gnus-thread-expunge-below nil
+ "All threads that have a total score less than this variable will be expunged.
+See `gnus-thread-score-function' for en explanation of what a
+\"thread score\" is."
+ :group 'gnus-treading
+ :group 'gnus-score-default
+ :type '(choice (const :tag "off" nil)
+ integer))
+
+(defcustom gnus-summary-mode-hook nil
+ "*A hook for Gnus summary mode.
+This hook is run before any variables are set in the summary buffer."
+ :group 'gnus-summary-various
+ :type 'hook)
+
+(defcustom gnus-summary-menu-hook nil
+ "*Hook run after the creation of the summary mode menu."
+ :group 'gnus-summary-visual
+ :type 'hook)
+
+(defcustom gnus-summary-exit-hook nil
+ "*A hook called on exit from the summary buffer.
+It will be called with point in the group buffer."
+ :group 'gnus-summary-exit
+ :type 'hook)
+
+(defcustom gnus-summary-prepare-hook nil
+ "*A hook called after the summary buffer has been generated.
+If you want to modify the summary buffer, you can use this hook."
+ :group 'gnus-summary-various
+ :type 'hook)
+
+(defcustom gnus-summary-generate-hook nil
+ "*A hook run just before generating the summary buffer.
+This hook is commonly used to customize threading variables and the
+like."
+ :group 'gnus-summary-various
+ :type 'hook)
+
+(defcustom gnus-select-group-hook nil
+ "*A hook called when a newsgroup is selected.
+
+If you'd like to simplify subjects like the
+`gnus-summary-next-same-subject' command does, you can use the
+following hook:
+
+ (setq gnus-select-group-hook
+ (list
+ (lambda ()
+ (mapcar (lambda (header)
+ (mail-header-set-subject
+ header
+ (gnus-simplify-subject
+ (mail-header-subject header) 're-only)))
+ gnus-newsgroup-headers))))"
+ :group 'gnus-group-select
+ :type 'hook)
+
+(defcustom gnus-select-article-hook nil
+ "*A hook called when an article is selected."
+ :group 'gnus-summary-choose
+ :type 'hook)
+
+(defcustom gnus-visual-mark-article-hook
+ (list 'gnus-highlight-selected-summary)
+ "*Hook run after selecting an article in the summary buffer.
+It is meant to be used for highlighting the article in some way. It
+is not run if `gnus-visual' is nil."
+ :group 'gnus-summary-visual
+ :type 'hook)
+
+;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+(defcustom gnus-structured-field-decoder 'identity
+ "Function to decode non-ASCII characters in structured field for summary."
+ :group 'gnus-various
+ :type 'function)
+
+(defcustom gnus-unstructured-field-decoder 'identity
+ "Function to decode non-ASCII characters in unstructured field for summary."
+ :group 'gnus-various
+ :type 'function)
+
+(defcustom gnus-parse-headers-hook
+ (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522)
+ "*A hook called before parsing the headers."
+ :group 'gnus-various
+ :type 'hook)
+
+(defcustom gnus-exit-group-hook nil
+ "*A hook called when exiting (not quitting) summary mode."
+ :group 'gnus-various
+ :type 'hook)
+
+(defcustom gnus-summary-update-hook
+ (list 'gnus-summary-highlight-line)
+ "*A hook called when a summary line is changed.
+The hook will not be called if `gnus-visual' is nil.
+
+The default function `gnus-summary-highlight-line' will
+highlight the line according to the `gnus-summary-highlight'
+variable."
+ :group 'gnus-summary-visual
+ :type 'hook)
+
+(defcustom gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
+ "*A hook called when an article is selected for the first time.
+The hook is intended to mark an article as read (or unread)
+automatically when it is selected."
+ :group 'gnus-summary-choose
+ :type 'hook)
+
+(defcustom gnus-group-no-more-groups-hook nil
+ "*A hook run when returning to group mode having no more (unread) groups."
+ :group 'gnus-group-select
+ :type 'hook)
+
+(defcustom gnus-ps-print-hook nil
+ "*A hook run before ps-printing something from Gnus."
+ :group 'gnus-summary
+ :type 'hook)
+
+(defcustom gnus-summary-selected-face 'gnus-summary-selected-face
+ "Face used for highlighting the current article in the summary buffer."
+ :group 'gnus-summary-visual
+ :type 'face)
+
+(defcustom gnus-summary-highlight
+ '(((= mark gnus-canceled-mark)
+ . gnus-summary-cancelled-face)
+ ((and (> score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ . gnus-summary-high-ticked-face)
+ ((and (< score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ . gnus-summary-low-ticked-face)
+ ((or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark))
+ . gnus-summary-normal-ticked-face)
+ ((and (> score default) (= mark gnus-ancient-mark))
+ . gnus-summary-high-ancient-face)
+ ((and (< score default) (= mark gnus-ancient-mark))
+ . gnus-summary-low-ancient-face)
+ ((= mark gnus-ancient-mark)
+ . gnus-summary-normal-ancient-face)
+ ((and (> score default) (= mark gnus-unread-mark))
+ . gnus-summary-high-unread-face)
+ ((and (< score default) (= mark gnus-unread-mark))
+ . gnus-summary-low-unread-face)
+ ((and (= mark gnus-unread-mark))
+ . gnus-summary-normal-unread-face)
+ ((> score default)
+ . gnus-summary-high-read-face)
+ ((< score default)
+ . gnus-summary-low-read-face)
+ (t
+ . gnus-summary-normal-read-face))
+ "Controls the highlighting of summary buffer lines.
+
+A list of (FORM . FACE) pairs. When deciding how a a particular
+summary line should be displayed, each form is evaluated. The content
+of the face field after the first true form is used. You can change
+how those summary lines are displayed, by editing the face field.
+
+You can use the following variables in the FORM field.
+
+score: The articles score
+default: The default article score.
+below: The score below which articles are automatically marked as read.
+mark: The articles mark."
+ :group 'gnus-summary-visual
+ :type '(repeat (cons (sexp :tag "Form" nil)
+ face)))
+
+(defcustom gnus-alter-header-function nil
+ "Function called to allow alteration of article header structures.
+The function is called with one parameter, the article header vector,
+which it may alter in any way.")
+
+;;; Internal variables
+
+(defvar gnus-scores-exclude-files nil)
+(defvar gnus-page-broken nil)
+
+(defvar gnus-original-article nil)
+(defvar gnus-article-internal-prepare-hook nil)
+(defvar gnus-newsgroup-process-stack nil)
+
+(defvar gnus-thread-indent-array nil)
+(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
+
+;; Avoid highlighting in kill files.
+(defvar gnus-summary-inhibit-highlight nil)
+(defvar gnus-newsgroup-selected-overlay nil)
+(defvar gnus-inhibit-limiting nil)
+(defvar gnus-newsgroup-adaptive-score-file nil)
+(defvar gnus-current-score-file nil)
+(defvar gnus-current-move-group nil)
+(defvar gnus-current-copy-group nil)
+(defvar gnus-current-crosspost-group nil)
+
+(defvar gnus-newsgroup-dependencies nil)
+(defvar gnus-newsgroup-adaptive nil)
+(defvar gnus-summary-display-article-function nil)
+(defvar gnus-summary-highlight-line-function nil
+ "Function called after highlighting a summary line.")
+
+(defvar gnus-summary-line-format-alist
+ `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
+ (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
+ (?s gnus-tmp-subject-or-nil ?s)
+ (?n gnus-tmp-name ?s)
+ (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
+ ?s)
+ (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
+ gnus-tmp-from) ?s)
+ (?F gnus-tmp-from ?s)
+ (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
+ (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
+ (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
+ (?o (gnus-date-iso8601 gnus-tmp-header) ?s)
+ (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
+ (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
+ (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
+ (?L gnus-tmp-lines ?d)
+ (?I gnus-tmp-indentation ?s)
+ (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
+ (?R gnus-tmp-replied ?c)
+ (?\[ gnus-tmp-opening-bracket ?c)
+ (?\] gnus-tmp-closing-bracket ?c)
+ (?\> (make-string gnus-tmp-level ? ) ?s)
+ (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
+ (?i gnus-tmp-score ?d)
+ (?z gnus-tmp-score-char ?c)
+ (?l (bbb-grouplens-score gnus-tmp-header) ?s)
+ (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
+ (?U gnus-tmp-unread ?c)
+ (?t (gnus-summary-number-of-articles-in-thread
+ (and (boundp 'thread) (car thread)) gnus-tmp-level)
+ ?d)
+ (?e (gnus-summary-number-of-articles-in-thread
+ (and (boundp 'thread) (car thread)) gnus-tmp-level t)
+ ?c)
+ (?u gnus-tmp-user-defined ?s)
+ (?P (gnus-pick-line-number) ?d))
+ "An alist of format specifications that can appear in summary lines,
+and what variables they correspond with, along with the type of the
+variable (string, integer, character, etc).")
+
+(defvar gnus-summary-dummy-line-format-alist
+ `((?S gnus-tmp-subject ?s)
+ (?N gnus-tmp-number ?d)
+ (?u gnus-tmp-user-defined ?s)))
+
+(defvar gnus-summary-mode-line-format-alist
+ `((?G gnus-tmp-group-name ?s)
+ (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
+ (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
+ (?A gnus-tmp-article-number ?d)
+ (?Z gnus-tmp-unread-and-unselected ?s)
+ (?V gnus-version ?s)
+ (?U gnus-tmp-unread-and-unticked ?d)
+ (?S gnus-tmp-subject ?s)
+ (?e gnus-tmp-unselected ?d)
+ (?u gnus-tmp-user-defined ?s)
+ (?d (length gnus-newsgroup-dormant) ?d)
+ (?t (length gnus-newsgroup-marked) ?d)
+ (?r (length gnus-newsgroup-reads) ?d)
+ (?E gnus-newsgroup-expunged-tally ?d)
+ (?s (gnus-current-score-file-nondirectory) ?s)))
+
+(defvar gnus-last-search-regexp nil
+ "Default regexp for article search command.")
+
+(defvar gnus-last-shell-command nil
+ "Default shell command on article.")
+
+(defvar gnus-newsgroup-begin nil)
+(defvar gnus-newsgroup-end nil)
+(defvar gnus-newsgroup-last-rmail nil)
+(defvar gnus-newsgroup-last-mail nil)
+(defvar gnus-newsgroup-last-folder nil)
+(defvar gnus-newsgroup-last-file nil)
+(defvar gnus-newsgroup-auto-expire nil)
+(defvar gnus-newsgroup-active nil)
+
+(defvar gnus-newsgroup-data nil)
+(defvar gnus-newsgroup-data-reverse nil)
+(defvar gnus-newsgroup-limit nil)
+(defvar gnus-newsgroup-limits nil)
+
+(defvar gnus-newsgroup-unreads nil
+ "List of unread articles in the current newsgroup.")
+
+(defvar gnus-newsgroup-unselected nil
+ "List of unselected unread articles in the current newsgroup.")
+
+(defvar gnus-newsgroup-reads nil
+ "Alist of read articles and article marks in the current newsgroup.")
+
+(defvar gnus-newsgroup-expunged-tally nil)
+
+(defvar gnus-newsgroup-marked nil
+ "List of ticked articles in the current newsgroup (a subset of unread art).")
+
+(defvar gnus-newsgroup-killed nil
+ "List of ranges of articles that have been through the scoring process.")
+
+(defvar gnus-newsgroup-cached nil
+ "List of articles that come from the article cache.")
+
+(defvar gnus-newsgroup-saved nil
+ "List of articles that have been saved.")
+
+(defvar gnus-newsgroup-kill-headers nil)
+
+(defvar gnus-newsgroup-replied nil
+ "List of articles that have been replied to in the current newsgroup.")
+
+(defvar gnus-newsgroup-expirable nil
+ "List of articles in the current newsgroup that can be expired.")
+
+(defvar gnus-newsgroup-processable nil
+ "List of articles in the current newsgroup that can be processed.")
+
+(defvar gnus-newsgroup-downloadable nil
+ "List of articles in the current newsgroup that can be processed.")
+
+(defvar gnus-newsgroup-undownloaded nil
+ "List of articles in the current newsgroup that haven't been downloaded..")
+
+(defvar gnus-newsgroup-unsendable nil
+ "List of articles in the current newsgroup that won't be sent.")
+
+(defvar gnus-newsgroup-bookmarks nil
+ "List of articles in the current newsgroup that have bookmarks.")
+
+(defvar gnus-newsgroup-dormant nil
+ "List of dormant articles in the current newsgroup.")
+
+(defvar gnus-newsgroup-scored nil
+ "List of scored articles in the current newsgroup.")
+
+(defvar gnus-newsgroup-headers nil
+ "List of article headers in the current newsgroup.")
+
+(defvar gnus-newsgroup-threads nil)
+
+(defvar gnus-newsgroup-prepared nil
+ "Whether the current group has been prepared properly.")
+
+(defvar gnus-newsgroup-ancient nil
+ "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
+
+(defvar gnus-newsgroup-sparse nil)
+
+(defvar gnus-current-article nil)
+(defvar gnus-article-current nil)
+(defvar gnus-current-headers nil)
+(defvar gnus-have-all-headers nil)
+(defvar gnus-last-article nil)
+(defvar gnus-newsgroup-history nil)
+
+(defconst gnus-summary-local-variables
+ '(gnus-newsgroup-name
+ gnus-newsgroup-begin gnus-newsgroup-end
+ gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
+ gnus-newsgroup-last-folder gnus-newsgroup-last-file
+ gnus-newsgroup-auto-expire gnus-newsgroup-unreads
+ gnus-newsgroup-unselected gnus-newsgroup-marked
+ gnus-newsgroup-reads gnus-newsgroup-saved
+ gnus-newsgroup-replied gnus-newsgroup-expirable
+ gnus-newsgroup-processable gnus-newsgroup-killed
+ gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
+ gnus-newsgroup-unsendable
+ gnus-newsgroup-bookmarks gnus-newsgroup-dormant
+ gnus-newsgroup-headers gnus-newsgroup-threads
+ gnus-newsgroup-prepared gnus-summary-highlight-line-function
+ gnus-current-article gnus-current-headers gnus-have-all-headers
+ gnus-last-article gnus-article-internal-prepare-hook
+ gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
+ gnus-newsgroup-scored gnus-newsgroup-kill-headers
+ gnus-thread-expunge-below
+ gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
+ (gnus-summary-mark-below . global)
+ gnus-newsgroup-active gnus-scores-exclude-files
+ gnus-newsgroup-history gnus-newsgroup-ancient
+ gnus-newsgroup-sparse gnus-newsgroup-process-stack
+ (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
+ gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
+ (gnus-newsgroup-expunged-tally . 0)
+ gnus-cache-removable-articles gnus-newsgroup-cached
+ gnus-newsgroup-data gnus-newsgroup-data-reverse
+ gnus-newsgroup-limit gnus-newsgroup-limits)
+ "Variables that are buffer-local to the summary buffers.")
+
+;; Byte-compiler warning.
+(defvar gnus-article-mode-map)
+
+;; Subject simplification.
+
+(defun gnus-simplify-whitespace (str)
+ "Remove excessive whitespace."
+ (let ((mystr str))
+ ;; Multiple spaces.
+ (while (string-match "[ \t][ \t]+" mystr)
+ (setq mystr (concat (substring mystr 0 (match-beginning 0))
+ " "
+ (substring mystr (match-end 0)))))
+ ;; Leading spaces.
+ (when (string-match "^[ \t]+" mystr)
+ (setq mystr (substring mystr (match-end 0))))
+ ;; Trailing spaces.
+ (when (string-match "[ \t]+$" mystr)
+ (setq mystr (substring mystr 0 (match-beginning 0))))
+ mystr))
+
+(defsubst gnus-simplify-subject-re (subject)
+ "Remove \"Re:\" from subject lines."
+ (if (string-match "^[Rr][Ee]: *" subject)
+ (substring subject (match-end 0))
+ subject))
+
+(defun gnus-simplify-subject (subject &optional re-only)
+ "Remove `Re:' and words in parentheses.
+If RE-ONLY is non-nil, strip leading `Re:'s only."
+ (let ((case-fold-search t)) ;Ignore case.
+ ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
+ (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
+ (setq subject (substring subject (match-end 0))))
+ ;; Remove uninteresting prefixes.
+ (when (and (not re-only)
+ gnus-simplify-ignored-prefixes
+ (string-match gnus-simplify-ignored-prefixes subject))
+ (setq subject (substring subject (match-end 0))))
+ ;; Remove words in parentheses from end.
+ (unless re-only
+ (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
+ (setq subject (substring subject 0 (match-beginning 0)))))
+ ;; Return subject string.
+ subject))
+
+;; Remove any leading "re:"s, any trailing paren phrases, and simplify
+;; all whitespace.
+(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (replace-match (or newtext ""))))
+
+(defun gnus-simplify-buffer-fuzzy ()
+ "Simplify string in the buffer fuzzily.
+The string in the accessible portion of the current buffer is simplified.
+It is assumed to be a single-line subject.
+Whitespace is generally cleaned up, and miscellaneous leading/trailing
+matter is removed. Additional things can be deleted by setting
+gnus-simplify-subject-fuzzy-regexp."
+ (let ((case-fold-search t)
+ (modified-tick))
+ (gnus-simplify-buffer-fuzzy-step "\t" " ")
+
+ (while (not (eq modified-tick (buffer-modified-tick)))
+ (setq modified-tick (buffer-modified-tick))
+ (cond
+ ((listp gnus-simplify-subject-fuzzy-regexp)
+ (mapcar 'gnus-simplify-buffer-fuzzy-step
+ gnus-simplify-subject-fuzzy-regexp))
+ (gnus-simplify-subject-fuzzy-regexp
+ (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
+ (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
+ (gnus-simplify-buffer-fuzzy-step
+ "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
+ (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1"))
+
+ (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$")
+ (gnus-simplify-buffer-fuzzy-step " +" " ")
+ (gnus-simplify-buffer-fuzzy-step " $")
+ (gnus-simplify-buffer-fuzzy-step "^ +")))
+
+(defun gnus-simplify-subject-fuzzy (subject)
+ "Simplify a subject string fuzzily.
+See `gnus-simplify-buffer-fuzzy' for details."
+ (save-excursion
+ (gnus-set-work-buffer)
+ (let ((case-fold-search t))
+ (insert subject)
+ (inline (gnus-simplify-buffer-fuzzy))
+ (buffer-string))))
+
+(defsubst gnus-simplify-subject-fully (subject)
+ "Simplify a subject string according to gnus-summary-gather-subject-limit."
+ (cond
+ (gnus-simplify-subject-functions
+ (gnus-map-function gnus-simplify-subject-functions subject))
+ ((null gnus-summary-gather-subject-limit)
+ (gnus-simplify-subject-re subject))
+ ((eq gnus-summary-gather-subject-limit 'fuzzy)
+ (gnus-simplify-subject-fuzzy subject))
+ ((numberp gnus-summary-gather-subject-limit)
+ (gnus-limit-string (gnus-simplify-subject-re subject)
+ gnus-summary-gather-subject-limit))
+ (t
+ subject)))
+
+(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
+ "Check whether two subjects are equal.
+If optional argument simple-first is t, first argument is already
+simplified."
+ (cond
+ ((null simple-first)
+ (equal (gnus-simplify-subject-fully s1)
+ (gnus-simplify-subject-fully s2)))
+ (t
+ (equal s1
+ (gnus-simplify-subject-fully s2)))))
+
+(defun gnus-summary-bubble-group ()
+ "Increase the score of the current group.
+This is a handy function to add to `gnus-summary-exit-hook' to
+increase the score of each group you read."
+ (gnus-group-add-score gnus-newsgroup-name))
+
+\f
+;;;
+;;; Gnus summary mode
+;;;
+
+(put 'gnus-summary-mode 'mode-class 'special)
+
+(when t
+ ;; Non-orthogonal keys
+
+ (gnus-define-keys gnus-summary-mode-map
+ " " gnus-summary-next-page
+ "\177" gnus-summary-prev-page
+ [delete] gnus-summary-prev-page
+ "\r" gnus-summary-scroll-up
+ "n" gnus-summary-next-unread-article
+ "p" gnus-summary-prev-unread-article
+ "N" gnus-summary-next-article
+ "P" gnus-summary-prev-article
+ "\M-\C-n" gnus-summary-next-same-subject
+ "\M-\C-p" gnus-summary-prev-same-subject
+ "\M-n" gnus-summary-next-unread-subject
+ "\M-p" gnus-summary-prev-unread-subject
+ "." gnus-summary-first-unread-article
+ "," gnus-summary-best-unread-article
+ "\M-s" gnus-summary-search-article-forward
+ "\M-r" gnus-summary-search-article-backward
+ "<" gnus-summary-beginning-of-article
+ ">" gnus-summary-end-of-article
+ "j" gnus-summary-goto-article
+ "^" gnus-summary-refer-parent-article
+ "\M-^" gnus-summary-refer-article
+ "u" gnus-summary-tick-article-forward
+ "!" gnus-summary-tick-article-forward
+ "U" gnus-summary-tick-article-backward
+ "d" gnus-summary-mark-as-read-forward
+ "D" gnus-summary-mark-as-read-backward
+ "E" gnus-summary-mark-as-expirable
+ "\M-u" gnus-summary-clear-mark-forward
+ "\M-U" gnus-summary-clear-mark-backward
+ "k" gnus-summary-kill-same-subject-and-select
+ "\C-k" gnus-summary-kill-same-subject
+ "\M-\C-k" gnus-summary-kill-thread
+ "\M-\C-l" gnus-summary-lower-thread
+ "e" gnus-summary-edit-article
+ "#" gnus-summary-mark-as-processable
+ "\M-#" gnus-summary-unmark-as-processable
+ "\M-\C-t" gnus-summary-toggle-threads
+ "\M-\C-s" gnus-summary-show-thread
+ "\M-\C-h" gnus-summary-hide-thread
+ "\M-\C-f" gnus-summary-next-thread
+ "\M-\C-b" gnus-summary-prev-thread
+ "\M-\C-u" gnus-summary-up-thread
+ "\M-\C-d" gnus-summary-down-thread
+ "&" gnus-summary-execute-command
+ "c" gnus-summary-catchup-and-exit
+ "\C-w" gnus-summary-mark-region-as-read
+ "\C-t" gnus-summary-toggle-truncation
+ "?" gnus-summary-mark-as-dormant
+ "\C-c\M-\C-s" gnus-summary-limit-include-expunged
+ "\C-c\C-s\C-n" gnus-summary-sort-by-number
+ "\C-c\C-s\C-l" gnus-summary-sort-by-lines
+ "\C-c\C-s\C-a" gnus-summary-sort-by-author
+ "\C-c\C-s\C-s" gnus-summary-sort-by-subject
+ "\C-c\C-s\C-d" gnus-summary-sort-by-date
+ "\C-c\C-s\C-i" gnus-summary-sort-by-score
+ "=" gnus-summary-expand-window
+ "\C-x\C-s" gnus-summary-reselect-current-group
+ "\M-g" gnus-summary-rescan-group
+ "w" gnus-summary-stop-page-breaking
+ "\C-c\C-r" gnus-summary-caesar-message
+ "\M-t" gnus-summary-toggle-mime
+ "f" gnus-summary-followup
+ "F" gnus-summary-followup-with-original
+ "C" gnus-summary-cancel-article
+ "r" gnus-summary-reply
+ "R" gnus-summary-reply-with-original
+ "\C-c\C-f" gnus-summary-mail-forward
+ "o" gnus-summary-save-article
+ "\C-o" gnus-summary-save-article-mail
+ "|" gnus-summary-pipe-output
+ "\M-k" gnus-summary-edit-local-kill
+ "\M-K" gnus-summary-edit-global-kill
+ ;; "V" gnus-version
+ "\C-c\C-d" gnus-summary-describe-group
+ "q" gnus-summary-exit
+ "Q" gnus-summary-exit-no-update
+ "\C-c\C-i" gnus-info-find-node
+ gnus-mouse-2 gnus-mouse-pick-article
+ "m" gnus-summary-mail-other-window
+ "a" gnus-summary-post-news
+ "x" gnus-summary-limit-to-unread
+ "s" gnus-summary-isearch-article
+ "t" gnus-article-hide-headers
+ "g" gnus-summary-show-article
+ "l" gnus-summary-goto-last-article
+ "\C-c\C-v\C-v" gnus-uu-decode-uu-view
+ "\C-d" gnus-summary-enter-digest-group
+ "\M-\C-d" gnus-summary-read-document
+ "\C-c\C-b" gnus-bug
+ "*" gnus-cache-enter-article
+ "\M-*" gnus-cache-remove-article
+ "\M-&" gnus-summary-universal-argument
+ "\C-l" gnus-recenter
+ "I" gnus-summary-increase-score
+ "L" gnus-summary-lower-score
+ "\M-i" gnus-symbolic-argument
+
+ "V" gnus-summary-score-map
+ "X" gnus-uu-extract-map
+ "S" gnus-summary-send-map)
+
+ ;; Sort of orthogonal keymap
+ (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
+ "t" gnus-summary-tick-article-forward
+ "!" gnus-summary-tick-article-forward
+ "d" gnus-summary-mark-as-read-forward
+ "r" gnus-summary-mark-as-read-forward
+ "c" gnus-summary-clear-mark-forward
+ " " gnus-summary-clear-mark-forward
+ "e" gnus-summary-mark-as-expirable
+ "x" gnus-summary-mark-as-expirable
+ "?" gnus-summary-mark-as-dormant
+ "b" gnus-summary-set-bookmark
+ "B" gnus-summary-remove-bookmark
+ "#" gnus-summary-mark-as-processable
+ "\M-#" gnus-summary-unmark-as-processable
+ "S" gnus-summary-limit-include-expunged
+ "C" gnus-summary-catchup
+ "H" gnus-summary-catchup-to-here
+ "\C-c" gnus-summary-catchup-all
+ "k" gnus-summary-kill-same-subject-and-select
+ "K" gnus-summary-kill-same-subject
+ "P" gnus-uu-mark-map)
+
+ (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
+ "c" gnus-summary-clear-above
+ "u" gnus-summary-tick-above
+ "m" gnus-summary-mark-above
+ "k" gnus-summary-kill-below)
+
+ (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
+ "/" gnus-summary-limit-to-subject
+ "n" gnus-summary-limit-to-articles
+ "w" gnus-summary-pop-limit
+ "s" gnus-summary-limit-to-subject
+ "a" gnus-summary-limit-to-author
+ "u" gnus-summary-limit-to-unread
+ "m" gnus-summary-limit-to-marks
+ "v" gnus-summary-limit-to-score
+ "D" gnus-summary-limit-include-dormant
+ "T" gnus-summary-limit-include-thread
+ "d" gnus-summary-limit-exclude-dormant
+ "t" gnus-summary-limit-to-age
+ "E" gnus-summary-limit-include-expunged
+ "c" gnus-summary-limit-exclude-childless-dormant
+ "C" gnus-summary-limit-mark-excluded-as-read)
+
+ (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
+ "n" gnus-summary-next-unread-article
+ "p" gnus-summary-prev-unread-article
+ "N" gnus-summary-next-article
+ "P" gnus-summary-prev-article
+ "\C-n" gnus-summary-next-same-subject
+ "\C-p" gnus-summary-prev-same-subject
+ "\M-n" gnus-summary-next-unread-subject
+ "\M-p" gnus-summary-prev-unread-subject
+ "f" gnus-summary-first-unread-article
+ "b" gnus-summary-best-unread-article
+ "j" gnus-summary-goto-article
+ "g" gnus-summary-goto-subject
+ "l" gnus-summary-goto-last-article
+ "o" gnus-summary-pop-article)
+
+ (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
+ "k" gnus-summary-kill-thread
+ "l" gnus-summary-lower-thread
+ "i" gnus-summary-raise-thread
+ "T" gnus-summary-toggle-threads
+ "t" gnus-summary-rethread-current
+ "^" gnus-summary-reparent-thread
+ "s" gnus-summary-show-thread
+ "S" gnus-summary-show-all-threads
+ "h" gnus-summary-hide-thread
+ "H" gnus-summary-hide-all-threads
+ "n" gnus-summary-next-thread
+ "p" gnus-summary-prev-thread
+ "u" gnus-summary-up-thread
+ "o" gnus-summary-top-thread
+ "d" gnus-summary-down-thread
+ "#" gnus-uu-mark-thread
+ "\M-#" gnus-uu-unmark-thread)
+
+ (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
+ "g" gnus-summary-prepare
+ "c" gnus-summary-insert-cached-articles)
+
+ (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
+ "c" gnus-summary-catchup-and-exit
+ "C" gnus-summary-catchup-all-and-exit
+ "E" gnus-summary-exit-no-update
+ "Q" gnus-summary-exit
+ "Z" gnus-summary-exit
+ "n" gnus-summary-catchup-and-goto-next-group
+ "R" gnus-summary-reselect-current-group
+ "G" gnus-summary-rescan-group
+ "N" gnus-summary-next-group
+ "s" gnus-summary-save-newsrc
+ "P" gnus-summary-prev-group)
+
+ (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
+ " " gnus-summary-next-page
+ "n" gnus-summary-next-page
+ "\177" gnus-summary-prev-page
+ [delete] gnus-summary-prev-page
+ "p" gnus-summary-prev-page
+ "\r" gnus-summary-scroll-up
+ "<" gnus-summary-beginning-of-article
+ ">" gnus-summary-end-of-article
+ "b" gnus-summary-beginning-of-article
+ "e" gnus-summary-end-of-article
+ "^" gnus-summary-refer-parent-article
+ "r" gnus-summary-refer-parent-article
+ "R" gnus-summary-refer-references
+ "T" gnus-summary-refer-thread
+ "g" gnus-summary-show-article
+ "s" gnus-summary-isearch-article
+ "P" gnus-summary-print-article)
+
+ (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
+ "b" gnus-article-add-buttons
+ "B" gnus-article-add-buttons-to-head
+ "o" gnus-article-treat-overstrike
+ "e" gnus-article-emphasize
+ "w" gnus-article-fill-cited-article
+ "c" gnus-article-remove-cr
+ "q" gnus-article-de-quoted-unreadable
+ "f" gnus-article-display-x-face
+ "l" gnus-summary-stop-page-breaking
+ "r" gnus-summary-caesar-message
+ "t" gnus-article-hide-headers
+ "v" gnus-summary-verbose-headers
+ "m" gnus-summary-toggle-mime
+ "h" gnus-article-treat-html)
+
+ (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
+ "a" gnus-article-hide
+ "h" gnus-article-hide-headers
+ "b" gnus-article-hide-boring-headers
+ "s" gnus-article-hide-signature
+ "c" gnus-article-hide-citation
+ "p" gnus-article-hide-pgp
+ "P" gnus-article-hide-pem
+ "\C-c" gnus-article-hide-citation-maybe)
+
+ (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
+ "a" gnus-article-highlight
+ "h" gnus-article-highlight-headers
+ "c" gnus-article-highlight-citation
+ "s" gnus-article-highlight-signature)
+
+ (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
+ "z" gnus-article-date-ut
+ "u" gnus-article-date-ut
+ "l" gnus-article-date-local
+ "e" gnus-article-date-lapsed
+ "o" gnus-article-date-original
+ "s" gnus-article-date-user)
+
+ (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
+ "t" gnus-article-remove-trailing-blank-lines
+ "l" gnus-article-strip-leading-blank-lines
+ "m" gnus-article-strip-multiple-blank-lines
+ "a" gnus-article-strip-blank-lines
+ "s" gnus-article-strip-leading-space)
+
+ (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
+ "v" gnus-version
+ "f" gnus-summary-fetch-faq
+ "d" gnus-summary-describe-group
+ "h" gnus-summary-describe-briefly
+ "i" gnus-info-find-node)
+
+ (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
+ "e" gnus-summary-expire-articles
+ "\M-\C-e" gnus-summary-expire-articles-now
+ "\177" gnus-summary-delete-article
+ [delete] gnus-summary-delete-article
+ "m" gnus-summary-move-article
+ "r" gnus-summary-respool-article
+ "w" gnus-summary-edit-article
+ "c" gnus-summary-copy-article
+ "B" gnus-summary-crosspost-article
+ "q" gnus-summary-respool-query
+ "i" gnus-summary-import-article
+ "p" gnus-summary-article-posted-p)
+
+ (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
+ "o" gnus-summary-save-article
+ "m" gnus-summary-save-article-mail
+ "F" gnus-summary-write-article-file
+ "r" gnus-summary-save-article-rmail
+ "f" gnus-summary-save-article-file
+ "b" gnus-summary-save-article-body-file
+ "h" gnus-summary-save-article-folder
+ "v" gnus-summary-save-article-vm
+ "p" gnus-summary-pipe-output
+ "s" gnus-soup-add-article))
+
+(defun gnus-summary-make-menu-bar ()
+ (gnus-turn-off-edit-menu 'summary)
+
+ (unless (boundp 'gnus-summary-misc-menu)
+
+ (easy-menu-define
+ gnus-summary-kill-menu gnus-summary-mode-map ""
+ (cons
+ "Score"
+ (nconc
+ (list
+ ["Enter score..." gnus-summary-score-entry t]
+ ["Customize" gnus-score-customize t])
+ (gnus-make-score-map 'increase)
+ (gnus-make-score-map 'lower)
+ '(("Mark"
+ ["Kill below" gnus-summary-kill-below t]
+ ["Mark above" gnus-summary-mark-above t]
+ ["Tick above" gnus-summary-tick-above t]
+ ["Clear above" gnus-summary-clear-above t])
+ ["Current score" gnus-summary-current-score t]
+ ["Set score" gnus-summary-set-score t]
+ ["Switch current score file..." gnus-score-change-score-file t]
+ ["Set mark below..." gnus-score-set-mark-below t]
+ ["Set expunge below..." gnus-score-set-expunge-below t]
+ ["Edit current score file" gnus-score-edit-current-scores t]
+ ["Edit score file" gnus-score-edit-file t]
+ ["Trace score" gnus-score-find-trace t]
+ ["Find words" gnus-score-find-favourite-words t]
+ ["Rescore buffer" gnus-summary-rescore t]
+ ["Increase score..." gnus-summary-increase-score t]
+ ["Lower score..." gnus-summary-lower-score t]))))
+
+ '(("Default header"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
+ :style radio
+ :selected (null gnus-score-default-header)]
+ ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
+ :style radio
+ :selected (eq gnus-score-default-header 'a)]
+ ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
+ :style radio
+ :selected (eq gnus-score-default-header 's)]
+ ["Article body"
+ (gnus-score-set-default 'gnus-score-default-header 'b)
+ :style radio
+ :selected (eq gnus-score-default-header 'b )]
+ ["All headers"
+ (gnus-score-set-default 'gnus-score-default-header 'h)
+ :style radio
+ :selected (eq gnus-score-default-header 'h )]
+ ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i)
+ :style radio
+ :selected (eq gnus-score-default-header 'i )]
+ ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
+ :style radio
+ :selected (eq gnus-score-default-header 't )]
+ ["Crossposting"
+ (gnus-score-set-default 'gnus-score-default-header 'x)
+ :style radio
+ :selected (eq gnus-score-default-header 'x )]
+ ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
+ :style radio
+ :selected (eq gnus-score-default-header 'l )]
+ ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
+ :style radio
+ :selected (eq gnus-score-default-header 'd )]
+ ["Followups to author"
+ (gnus-score-set-default 'gnus-score-default-header 'f)
+ :style radio
+ :selected (eq gnus-score-default-header 'f )])
+ ("Default type"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
+ :style radio
+ :selected (null gnus-score-default-type)]
+ ;; The `:active' key is commented out in the following,
+ ;; because the GNU Emacs hack to support radio buttons use
+ ;; active to indicate which button is selected.
+ ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 's)]
+ ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'r)]
+ ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'e)]
+ ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'f)]
+ ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'b)]
+ ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'n)]
+ ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'a)]
+ ["Less than number"
+ (gnus-score-set-default 'gnus-score-default-type '<)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '<)]
+ ["Equal to number"
+ (gnus-score-set-default 'gnus-score-default-type '=)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '=)]
+ ["Greater than number"
+ (gnus-score-set-default 'gnus-score-default-type '>)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '>)])
+ ["Default fold" gnus-score-default-fold-toggle
+ :style toggle
+ :selected gnus-score-default-fold]
+ ("Default duration"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil)
+ :style radio
+ :selected (null gnus-score-default-duration)]
+ ["Permanent"
+ (gnus-score-set-default 'gnus-score-default-duration 'p)
+ :style radio
+ :selected (eq gnus-score-default-duration 'p)]
+ ["Temporary"
+ (gnus-score-set-default 'gnus-score-default-duration 't)
+ :style radio
+ :selected (eq gnus-score-default-duration 't)]
+ ["Immediate"
+ (gnus-score-set-default 'gnus-score-default-duration 'i)
+ :style radio
+ :selected (eq gnus-score-default-duration 'i)]))
+
+ (easy-menu-define
+ gnus-summary-article-menu gnus-summary-mode-map ""
+ '("Article"
+ ("Hide"
+ ["All" gnus-article-hide t]
+ ["Headers" gnus-article-hide-headers t]
+ ["Signature" gnus-article-hide-signature t]
+ ["Citation" gnus-article-hide-citation t]
+ ["PGP" gnus-article-hide-pgp t]
+ ["Boring headers" gnus-article-hide-boring-headers t])
+ ("Highlight"
+ ["All" gnus-article-highlight t]
+ ["Headers" gnus-article-highlight-headers t]
+ ["Signature" gnus-article-highlight-signature t]
+ ["Citation" gnus-article-highlight-citation t])
+ ("Date"
+ ["Local" gnus-article-date-local t]
+ ["UT" gnus-article-date-ut t]
+ ["Original" gnus-article-date-original t]
+ ["Lapsed" gnus-article-date-lapsed t]
+ ["User-defined" gnus-article-date-user t])
+ ("Washing"
+ ("Remove Blanks"
+ ["Leading" gnus-article-strip-leading-blank-lines t]
+ ["Multiple" gnus-article-strip-multiple-blank-lines t]
+ ["Trailing" gnus-article-remove-trailing-blank-lines t]
+ ["All of the above" gnus-article-strip-blank-lines t]
+ ["Leading space" gnus-article-strip-leading-space t])
+ ["Overstrike" gnus-article-treat-overstrike t]
+ ["Emphasis" gnus-article-emphasize t]
+ ["Word wrap" gnus-article-fill-cited-article t]
+ ["CR" gnus-article-remove-cr t]
+ ["Show X-Face" gnus-article-display-x-face t]
+ ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
+ ["UnHTMLize" gnus-article-treat-html t]
+ ["Rot 13" gnus-summary-caesar-message t]
+ ["Unix pipe" gnus-summary-pipe-message t]
+ ["Add buttons" gnus-article-add-buttons t]
+ ["Add buttons to head" gnus-article-add-buttons-to-head t]
+ ["Stop page breaking" gnus-summary-stop-page-breaking t]
+ ["Toggle MIME" gnus-summary-toggle-mime t]
+ ["Verbose header" gnus-summary-verbose-headers t]
+ ["Toggle header" gnus-summary-toggle-header t])
+ ("Output"
+ ["Save in default format" gnus-summary-save-article t]
+ ["Save in file" gnus-summary-save-article-file t]
+ ["Save in Unix mail format" gnus-summary-save-article-mail t]
+ ["Write to file" gnus-summary-write-article-mail t]
+ ["Save in MH folder" gnus-summary-save-article-folder t]
+ ["Save in VM folder" gnus-summary-save-article-vm t]
+ ["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
+ ["Save body in file" gnus-summary-save-article-body-file t]
+ ["Pipe through a filter" gnus-summary-pipe-output t]
+ ["Add to SOUP packet" gnus-soup-add-article t]
+ ["Print" gnus-summary-print-article t])
+ ("Backend"
+ ["Respool article..." gnus-summary-respool-article t]
+ ["Move article..." gnus-summary-move-article
+ (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name)]
+ ["Copy article..." gnus-summary-copy-article t]
+ ["Crosspost article..." gnus-summary-crosspost-article
+ (gnus-check-backend-function
+ 'request-replace-article gnus-newsgroup-name)]
+ ["Import file..." gnus-summary-import-article t]
+ ["Check if posted" gnus-summary-article-posted-p t]
+ ["Edit article" gnus-summary-edit-article
+ (not (gnus-group-read-only-p))]
+ ["Delete article" gnus-summary-delete-article
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)]
+ ["Query respool" gnus-summary-respool-query t]
+ ["Delete expirable articles" gnus-summary-expire-articles-now
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)])
+ ("Extract"
+ ["Uudecode" gnus-uu-decode-uu t]
+ ["Uudecode and save" gnus-uu-decode-uu-and-save t]
+ ["Unshar" gnus-uu-decode-unshar t]
+ ["Unshar and save" gnus-uu-decode-unshar-and-save t]
+ ["Save" gnus-uu-decode-save t]
+ ["Binhex" gnus-uu-decode-binhex t]
+ ["Postscript" gnus-uu-decode-postscript t])
+ ("Cache"
+ ["Enter article" gnus-cache-enter-article t]
+ ["Remove article" gnus-cache-remove-article t])
+ ["Enter digest buffer" gnus-summary-enter-digest-group t]
+ ["Isearch article..." gnus-summary-isearch-article t]
+ ["Beginning of the article" gnus-summary-beginning-of-article t]
+ ["End of the article" gnus-summary-end-of-article t]
+ ["Fetch parent of article" gnus-summary-refer-parent-article t]
+ ["Fetch referenced articles" gnus-summary-refer-references t]
+ ["Fetch current thread" gnus-summary-refer-thread t]
+ ["Fetch article with id..." gnus-summary-refer-article t]
+ ["Redisplay" gnus-summary-show-article t]))
+
+ (easy-menu-define
+ gnus-summary-thread-menu gnus-summary-mode-map ""
+ '("Threads"
+ ["Toggle threading" gnus-summary-toggle-threads t]
+ ["Hide threads" gnus-summary-hide-all-threads t]
+ ["Show threads" gnus-summary-show-all-threads t]
+ ["Hide thread" gnus-summary-hide-thread t]
+ ["Show thread" gnus-summary-show-thread t]
+ ["Go to next thread" gnus-summary-next-thread t]
+ ["Go to previous thread" gnus-summary-prev-thread t]
+ ["Go down thread" gnus-summary-down-thread t]
+ ["Go up thread" gnus-summary-up-thread t]
+ ["Top of thread" gnus-summary-top-thread t]
+ ["Mark thread as read" gnus-summary-kill-thread t]
+ ["Lower thread score" gnus-summary-lower-thread t]
+ ["Raise thread score" gnus-summary-raise-thread t]
+ ["Rethread current" gnus-summary-rethread-current t]
+ ))
+
+ (easy-menu-define
+ gnus-summary-post-menu gnus-summary-mode-map ""
+ '("Post"
+ ["Post an article" gnus-summary-post-news t]
+ ["Followup" gnus-summary-followup t]
+ ["Followup and yank" gnus-summary-followup-with-original t]
+ ["Supersede article" gnus-summary-supersede-article t]
+ ["Cancel article" gnus-summary-cancel-article t]
+ ["Reply" gnus-summary-reply t]
+ ["Reply and yank" gnus-summary-reply-with-original t]
+ ["Wide reply" gnus-summary-wide-reply t]
+ ["Wide reply and yank" gnus-summary-wide-reply-with-original t]
+ ["Mail forward" gnus-summary-mail-forward t]
+ ["Post forward" gnus-summary-post-forward t]
+ ["Digest and mail" gnus-uu-digest-mail-forward t]
+ ["Digest and post" gnus-uu-digest-post-forward t]
+ ["Resend message" gnus-summary-resend-message t]
+ ["Send bounced mail" gnus-summary-resend-bounced-mail t]
+ ["Send a mail" gnus-summary-mail-other-window t]
+ ["Uuencode and post" gnus-uu-post-news t]
+ ["Followup via news" gnus-summary-followup-to-mail t]
+ ["Followup via news and yank"
+ gnus-summary-followup-to-mail-with-original t]
+ ;;("Draft"
+ ;;["Send" gnus-summary-send-draft t]
+ ;;["Send bounced" gnus-resend-bounced-mail t])
+ ))
+
+ (easy-menu-define
+ gnus-summary-misc-menu gnus-summary-mode-map ""
+ '("Misc"
+ ("Mark Read"
+ ["Mark as read" gnus-summary-mark-as-read-forward t]
+ ["Mark same subject and select"
+ gnus-summary-kill-same-subject-and-select t]
+ ["Mark same subject" gnus-summary-kill-same-subject t]
+ ["Catchup" gnus-summary-catchup t]
+ ["Catchup all" gnus-summary-catchup-all t]
+ ["Catchup to here" gnus-summary-catchup-to-here t]
+ ["Catchup region" gnus-summary-mark-region-as-read t]
+ ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
+ ("Mark Various"
+ ["Tick" gnus-summary-tick-article-forward t]
+ ["Mark as dormant" gnus-summary-mark-as-dormant t]
+ ["Remove marks" gnus-summary-clear-mark-forward t]
+ ["Set expirable mark" gnus-summary-mark-as-expirable t]
+ ["Set bookmark" gnus-summary-set-bookmark t]
+ ["Remove bookmark" gnus-summary-remove-bookmark t])
+ ("Mark Limit"
+ ["Marks..." gnus-summary-limit-to-marks t]
+ ["Subject..." gnus-summary-limit-to-subject t]
+ ["Author..." gnus-summary-limit-to-author t]
+ ["Age..." gnus-summary-limit-to-age t]
+ ["Score" gnus-summary-limit-to-score t]
+ ["Unread" gnus-summary-limit-to-unread t]
+ ["Non-dormant" gnus-summary-limit-exclude-dormant t]
+ ["Articles" gnus-summary-limit-to-articles t]
+ ["Pop limit" gnus-summary-pop-limit t]
+ ["Show dormant" gnus-summary-limit-include-dormant t]
+ ["Hide childless dormant"
+ gnus-summary-limit-exclude-childless-dormant t]
+ ;;["Hide thread" gnus-summary-limit-exclude-thread t]
+ ["Show expunged" gnus-summary-show-all-expunged t])
+ ("Process Mark"
+ ["Set mark" gnus-summary-mark-as-processable t]
+ ["Remove mark" gnus-summary-unmark-as-processable t]
+ ["Remove all marks" gnus-summary-unmark-all-processable t]
+ ["Mark above" gnus-uu-mark-over t]
+ ["Mark series" gnus-uu-mark-series t]
+ ["Mark region" gnus-uu-mark-region t]
+ ["Mark by regexp..." gnus-uu-mark-by-regexp t]
+ ["Mark all" gnus-uu-mark-all t]
+ ["Mark buffer" gnus-uu-mark-buffer t]
+ ["Mark sparse" gnus-uu-mark-sparse t]
+ ["Mark thread" gnus-uu-mark-thread t]
+ ["Unmark thread" gnus-uu-unmark-thread t]
+ ("Process Mark Sets"
+ ["Kill" gnus-summary-kill-process-mark t]
+ ["Yank" gnus-summary-yank-process-mark
+ gnus-newsgroup-process-stack]
+ ["Save" gnus-summary-save-process-mark t]))
+ ("Scroll article"
+ ["Page forward" gnus-summary-next-page t]
+ ["Page backward" gnus-summary-prev-page t]
+ ["Line forward" gnus-summary-scroll-up t])
+ ("Move"
+ ["Next unread article" gnus-summary-next-unread-article t]
+ ["Previous unread article" gnus-summary-prev-unread-article t]
+ ["Next article" gnus-summary-next-article t]
+ ["Previous article" gnus-summary-prev-article t]
+ ["Next unread subject" gnus-summary-next-unread-subject t]
+ ["Previous unread subject" gnus-summary-prev-unread-subject t]
+ ["Next article same subject" gnus-summary-next-same-subject t]
+ ["Previous article same subject" gnus-summary-prev-same-subject t]
+ ["First unread article" gnus-summary-first-unread-article t]
+ ["Best unread article" gnus-summary-best-unread-article t]
+ ["Go to subject number..." gnus-summary-goto-subject t]
+ ["Go to article number..." gnus-summary-goto-article t]
+ ["Go to the last article" gnus-summary-goto-last-article t]
+ ["Pop article off history" gnus-summary-pop-article t])
+ ("Sort"
+ ["Sort by number" gnus-summary-sort-by-number t]
+ ["Sort by author" gnus-summary-sort-by-author t]
+ ["Sort by subject" gnus-summary-sort-by-subject t]
+ ["Sort by date" gnus-summary-sort-by-date t]
+ ["Sort by score" gnus-summary-sort-by-score t]
+ ["Sort by lines" gnus-summary-sort-by-lines t])
+ ("Help"
+ ["Fetch group FAQ" gnus-summary-fetch-faq t]
+ ["Describe group" gnus-summary-describe-group t]
+ ["Read manual" gnus-info-find-node t])
+ ("Modes"
+ ["Pick and read" gnus-pick-mode t]
+ ["Binary" gnus-binary-mode t])
+ ("Regeneration"
+ ["Regenerate" gnus-summary-prepare t]
+ ["Insert cached articles" gnus-summary-insert-cached-articles t]
+ ["Toggle threading" gnus-summary-toggle-threads t])
+ ["Filter articles..." gnus-summary-execute-command t]
+ ["Run command on subjects..." gnus-summary-universal-argument t]
+ ["Search articles forward..." gnus-summary-search-article-forward t]
+ ["Search articles backward..." gnus-summary-search-article-backward t]
+ ["Toggle line truncation" gnus-summary-toggle-truncation t]
+ ["Expand window" gnus-summary-expand-window t]
+ ["Expire expirable articles" gnus-summary-expire-articles
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)]
+ ["Edit local kill file" gnus-summary-edit-local-kill t]
+ ["Edit main kill file" gnus-summary-edit-global-kill t]
+ ("Exit"
+ ["Catchup and exit" gnus-summary-catchup-and-exit t]
+ ["Catchup all and exit" gnus-summary-catchup-and-exit t]
+ ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
+ ["Exit group" gnus-summary-exit t]
+ ["Exit group without updating" gnus-summary-exit-no-update t]
+ ["Exit and goto next group" gnus-summary-next-group t]
+ ["Exit and goto prev group" gnus-summary-prev-group t]
+ ["Reselect group" gnus-summary-reselect-current-group t]
+ ["Rescan group" gnus-summary-rescan-group t]
+ ["Update dribble" gnus-summary-save-newsrc t])))
+
+ (run-hooks 'gnus-summary-menu-hook)))
+
+(defun gnus-score-set-default (var value)
+ "A version of set that updates the GNU Emacs menu-bar."
+ (set var value)
+ ;; It is the message that forces the active status to be updated.
+ (message ""))
+
+(defun gnus-make-score-map (type)
+ "Make a summary score map of type TYPE."
+ (if t
+ nil
+ (let ((headers '(("author" "from" string)
+ ("subject" "subject" string)
+ ("article body" "body" string)
+ ("article head" "head" string)
+ ("xref" "xref" string)
+ ("lines" "lines" number)
+ ("followups to author" "followup" string)))
+ (types '((number ("less than" <)
+ ("greater than" >)
+ ("equal" =))
+ (string ("substring" s)
+ ("exact string" e)
+ ("fuzzy string" f)
+ ("regexp" r))))
+ (perms '(("temporary" (current-time-string))
+ ("permanent" nil)
+ ("immediate" now)))
+ header)
+ (list
+ (apply
+ 'nconc
+ (list
+ (if (eq type 'lower)
+ "Lower score"
+ "Increase score"))
+ (let (outh)
+ (while headers
+ (setq header (car headers))
+ (setq outh
+ (cons
+ (apply
+ 'nconc
+ (list (car header))
+ (let ((ts (cdr (assoc (nth 2 header) types)))
+ outt)
+ (while ts
+ (setq outt
+ (cons
+ (apply
+ 'nconc
+ (list (caar ts))
+ (let ((ps perms)
+ outp)
+ (while ps
+ (setq outp
+ (cons
+ (vector
+ (caar ps)
+ (list
+ 'gnus-summary-score-entry
+ (nth 1 header)
+ (if (or (string= (nth 1 header)
+ "head")
+ (string= (nth 1 header)
+ "body"))
+ ""
+ (list 'gnus-summary-header
+ (nth 1 header)))
+ (list 'quote (nth 1 (car ts)))
+ (list 'gnus-score-default nil)
+ (nth 1 (car ps))
+ t)
+ t)
+ outp))
+ (setq ps (cdr ps)))
+ (list (nreverse outp))))
+ outt))
+ (setq ts (cdr ts)))
+ (list (nreverse outt))))
+ outh))
+ (setq headers (cdr headers)))
+ (list (nreverse outh))))))))
+
+\f
+
+(defun gnus-summary-mode (&optional group)
+ "Major mode for reading articles.
+
+All normal editing commands are switched off.
+\\<gnus-summary-mode-map>
+Each line in this buffer represents one article. To read an
+article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards
+and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
+respectively.
+
+You can also post articles and send mail from this buffer. To
+follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
+of an article, type `\\[gnus-summary-reply]'.
+
+There are approx. one gazillion commands you can execute in this
+buffer; read the info pages for more information (`\\[gnus-info-find-node]').
+
+The following commands are available:
+
+\\{gnus-summary-mode-map}"
+ (interactive)
+ (when (gnus-visual-p 'summary-menu 'menu)
+ (gnus-summary-make-menu-bar))
+ (kill-all-local-variables)
+ (gnus-summary-make-local-variables)
+ (gnus-make-thread-indent-array)
+ (gnus-simplify-mode-line)
+ (setq major-mode 'gnus-summary-mode)
+ (setq mode-name "Summary")
+ (make-local-variable 'minor-mode-alist)
+ (use-local-map gnus-summary-mode-map)
+ (buffer-disable-undo (current-buffer))
+ (setq buffer-read-only t) ;Disable modification
+ (setq truncate-lines t)
+ (setq selective-display t)
+ (setq selective-display-ellipses t) ;Display `...'
+ (gnus-summary-set-display-table)
+ (gnus-set-default-directory)
+ (setq gnus-newsgroup-name group)
+ (make-local-variable 'gnus-summary-line-format)
+ (make-local-variable 'gnus-summary-line-format-spec)
+ (make-local-variable 'gnus-summary-mark-positions)
+ (make-local-hook 'post-command-hook)
+ (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
+ (run-hooks 'gnus-summary-mode-hook)
+ (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
+ (gnus-update-summary-mark-positions))
+
+(defun gnus-summary-make-local-variables ()
+ "Make all the local summary buffer variables."
+ (let ((locals gnus-summary-local-variables)
+ global local)
+ (while (setq local (pop locals))
+ (if (consp local)
+ (progn
+ (if (eq (cdr local) 'global)
+ ;; Copy the global value of the variable.
+ (setq global (symbol-value (car local)))
+ ;; Use the value from the list.
+ (setq global (eval (cdr local))))
+ (make-local-variable (car local))
+ (set (car local) global))
+ ;; Simple nil-valued local variable.
+ (make-local-variable local)
+ (set local nil)))))
+
+(defun gnus-summary-clear-local-variables ()
+ (let ((locals gnus-summary-local-variables))
+ (while locals
+ (if (consp (car locals))
+ (and (vectorp (caar locals))
+ (set (caar locals) nil))
+ (and (vectorp (car locals))
+ (set (car locals) nil)))
+ (setq locals (cdr locals)))))
+
+;; Summary data functions.
+
+(defmacro gnus-data-number (data)
+ `(car ,data))
+
+(defmacro gnus-data-set-number (data number)
+ `(setcar ,data ,number))
+
+(defmacro gnus-data-mark (data)
+ `(nth 1 ,data))
+
+(defmacro gnus-data-set-mark (data mark)
+ `(setcar (nthcdr 1 ,data) ,mark))
+
+(defmacro gnus-data-pos (data)
+ `(nth 2 ,data))
+
+(defmacro gnus-data-set-pos (data pos)
+ `(setcar (nthcdr 2 ,data) ,pos))
+
+(defmacro gnus-data-header (data)
+ `(nth 3 ,data))
+
+(defmacro gnus-data-set-header (data header)
+ `(setf (nth 3 ,data) ,header))
+
+(defmacro gnus-data-level (data)
+ `(nth 4 ,data))
+
+(defmacro gnus-data-unread-p (data)
+ `(= (nth 1 ,data) gnus-unread-mark))
+
+(defmacro gnus-data-read-p (data)
+ `(/= (nth 1 ,data) gnus-unread-mark))
+
+(defmacro gnus-data-pseudo-p (data)
+ `(consp (nth 3 ,data)))
+
+(defmacro gnus-data-find (number)
+ `(assq ,number gnus-newsgroup-data))
+
+(defmacro gnus-data-find-list (number &optional data)
+ `(let ((bdata ,(or data 'gnus-newsgroup-data)))
+ (memq (assq ,number bdata)
+ bdata)))
+
+(defmacro gnus-data-make (number mark pos header level)
+ `(list ,number ,mark ,pos ,header ,level))
+
+(defun gnus-data-enter (after-article number mark pos header level offset)
+ (let ((data (gnus-data-find-list after-article)))
+ (unless data
+ (error "No such article: %d" after-article))
+ (setcdr data (cons (gnus-data-make number mark pos header level)
+ (cdr data)))
+ (setq gnus-newsgroup-data-reverse nil)
+ (gnus-data-update-list (cddr data) offset)))
+
+(defun gnus-data-enter-list (after-article list &optional offset)
+ (when list
+ (let ((data (and after-article (gnus-data-find-list after-article)))
+ (ilist list))
+ (or data (not after-article) (error "No such article: %d" after-article))
+ ;; Find the last element in the list to be spliced into the main
+ ;; list.
+ (while (cdr list)
+ (setq list (cdr list)))
+ (if (not data)
+ (progn
+ (setcdr list gnus-newsgroup-data)
+ (setq gnus-newsgroup-data ilist)
+ (when offset
+ (gnus-data-update-list (cdr list) offset)))
+ (setcdr list (cdr data))
+ (setcdr data ilist)
+ (when offset
+ (gnus-data-update-list (cdr list) offset)))
+ (setq gnus-newsgroup-data-reverse nil))))
+
+(defun gnus-data-remove (article &optional offset)
+ (let ((data gnus-newsgroup-data))
+ (if (= (gnus-data-number (car data)) article)
+ (progn
+ (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
+ gnus-newsgroup-data-reverse nil)
+ (when offset
+ (gnus-data-update-list gnus-newsgroup-data offset)))
+ (while (cdr data)
+ (when (= (gnus-data-number (cadr data)) article)
+ (setcdr data (cddr data))
+ (when offset
+ (gnus-data-update-list (cdr data) offset))
+ (setq data nil
+ gnus-newsgroup-data-reverse nil))
+ (setq data (cdr data))))))
+
+(defmacro gnus-data-list (backward)
+ `(if ,backward
+ (or gnus-newsgroup-data-reverse
+ (setq gnus-newsgroup-data-reverse
+ (reverse gnus-newsgroup-data)))
+ gnus-newsgroup-data))
+
+(defun gnus-data-update-list (data offset)
+ "Add OFFSET to the POS of all data entries in DATA."
+ (while data
+ (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
+ (setq data (cdr data))))
+
+(defun gnus-data-compute-positions ()
+ "Compute the positions of all articles."
+ (let ((data gnus-newsgroup-data)
+ pos)
+ (while data
+ (when (setq pos (text-property-any
+ (point-min) (point-max)
+ 'gnus-number (gnus-data-number (car data))))
+ (gnus-data-set-pos (car data) (+ pos 3)))
+ (setq data (cdr data)))))
+
+(defun gnus-summary-article-pseudo-p (article)
+ "Say whether this article is a pseudo article or not."
+ (not (vectorp (gnus-data-header (gnus-data-find article)))))
+
+(defmacro gnus-summary-article-sparse-p (article)
+ "Say whether this article is a sparse article or not."
+ `(memq ,article gnus-newsgroup-sparse))
+
+(defmacro gnus-summary-article-ancient-p (article)
+ "Say whether this article is a sparse article or not."
+ `(memq ,article gnus-newsgroup-ancient))
+
+(defun gnus-article-parent-p (number)
+ "Say whether this article is a parent or not."
+ (let ((data (gnus-data-find-list number)))
+ (and (cdr data) ; There has to be an article after...
+ (< (gnus-data-level (car data)) ; And it has to have a higher level.
+ (gnus-data-level (nth 1 data))))))
+
+(defun gnus-article-children (number)
+ "Return a list of all children to NUMBER."
+ (let* ((data (gnus-data-find-list number))
+ (level (gnus-data-level (car data)))
+ children)
+ (setq data (cdr data))
+ (while (and data
+ (= (gnus-data-level (car data)) (1+ level)))
+ (push (gnus-data-number (car data)) children)
+ (setq data (cdr data)))
+ children))
+
+(defmacro gnus-summary-skip-intangible ()
+ "If the current article is intangible, then jump to a different article."
+ '(let ((to (get-text-property (point) 'gnus-intangible)))
+ (and to (gnus-summary-goto-subject to))))
+
+(defmacro gnus-summary-article-intangible-p ()
+ "Say whether this article is intangible or not."
+ '(get-text-property (point) 'gnus-intangible))
+
+(defun gnus-article-read-p (article)
+ "Say whether ARTICLE is read or not."
+ (not (or (memq article gnus-newsgroup-marked)
+ (memq article gnus-newsgroup-unreads)
+ (memq article gnus-newsgroup-unselected)
+ (memq article gnus-newsgroup-dormant))))
+
+;; Some summary mode macros.
+
+(defmacro gnus-summary-article-number ()
+ "The article number of the article on the current line.
+If there isn's an article number here, then we return the current
+article number."
+ '(progn
+ (gnus-summary-skip-intangible)
+ (or (get-text-property (point) 'gnus-number)
+ (gnus-summary-last-subject))))
+
+(defmacro gnus-summary-article-header (&optional number)
+ `(gnus-data-header (gnus-data-find
+ ,(or number '(gnus-summary-article-number)))))
+
+(defmacro gnus-summary-thread-level (&optional number)
+ `(if (and (eq gnus-summary-make-false-root 'dummy)
+ (get-text-property (point) 'gnus-intangible))
+ 0
+ (gnus-data-level (gnus-data-find
+ ,(or number '(gnus-summary-article-number))))))
+
+(defmacro gnus-summary-article-mark (&optional number)
+ `(gnus-data-mark (gnus-data-find
+ ,(or number '(gnus-summary-article-number)))))
+
+(defmacro gnus-summary-article-pos (&optional number)
+ `(gnus-data-pos (gnus-data-find
+ ,(or number '(gnus-summary-article-number)))))
+
+(defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
+(defmacro gnus-summary-article-subject (&optional number)
+ "Return current subject string or nil if nothing."
+ `(let ((headers
+ ,(if number
+ `(gnus-data-header (assq ,number gnus-newsgroup-data))
+ '(gnus-data-header (assq (gnus-summary-article-number)
+ gnus-newsgroup-data)))))
+ (and headers
+ (vectorp headers)
+ (mail-header-subject headers))))
+
+(defmacro gnus-summary-article-score (&optional number)
+ "Return current article score."
+ `(or (cdr (assq ,(or number '(gnus-summary-article-number))
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0))
+
+(defun gnus-summary-article-children (&optional number)
+ (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
+ (level (gnus-data-level (car data)))
+ l children)
+ (while (and (setq data (cdr data))
+ (> (setq l (gnus-data-level (car data))) level))
+ (and (= (1+ level) l)
+ (push (gnus-data-number (car data))
+ children)))
+ (nreverse children)))
+
+(defun gnus-summary-article-parent (&optional number)
+ (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
+ (gnus-data-list t)))
+ (level (gnus-data-level (car data))))
+ (if (zerop level)
+ () ; This is a root.
+ ;; We search until we find an article with a level less than
+ ;; this one. That function has to be the parent.
+ (while (and (setq data (cdr data))
+ (not (< (gnus-data-level (car data)) level))))
+ (and data (gnus-data-number (car data))))))
+
+(defun gnus-unread-mark-p (mark)
+ "Say whether MARK is the unread mark."
+ (= mark gnus-unread-mark))
+
+(defun gnus-read-mark-p (mark)
+ "Say whether MARK is one of the marks that mark as read.
+This is all marks except unread, ticked, dormant, and expirable."
+ (not (or (= mark gnus-unread-mark)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark)
+ (= mark gnus-expirable-mark))))
+
+(defmacro gnus-article-mark (number)
+ `(cond
+ ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
+ ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark)
+ ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
+ ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
+ ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
+ ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
+ ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark)
+ (t (or (cdr (assq ,number gnus-newsgroup-reads))
+ gnus-ancient-mark))))
+
+;; Saving hidden threads.
+
+(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
+(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
+
+(defmacro gnus-save-hidden-threads (&rest forms)
+ "Save hidden threads, eval FORMS, and restore the hidden threads."
+ (let ((config (make-symbol "config")))
+ `(let ((,config (gnus-hidden-threads-configuration)))
+ (unwind-protect
+ (save-excursion
+ ,@forms)
+ (gnus-restore-hidden-threads-configuration ,config)))))
+
+(defun gnus-hidden-threads-configuration ()
+ "Return the current hidden threads configuration."
+ (save-excursion
+ (let (config)
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (push (1- (point)) config))
+ config)))
+
+(defun gnus-restore-hidden-threads-configuration (config)
+ "Restore hidden threads configuration from CONFIG."
+ (let (point buffer-read-only)
+ (while (setq point (pop config))
+ (when (and (< point (point-max))
+ (goto-char point)
+ (= (following-char) ?\n))
+ (subst-char-in-region point (1+ point) ?\n ?\r)))))
+
+;; Various summary mode internalish functions.
+
+(defun gnus-mouse-pick-article (e)
+ (interactive "e")
+ (mouse-set-point e)
+ (gnus-summary-next-page nil t))
+
+(defun gnus-summary-set-display-table ()
+ ;; Change the display table. Odd characters have a tendency to mess
+ ;; up nicely formatted displays - we make all possible glyphs
+ ;; display only a single character.
+
+ ;; We start from the standard display table, if any.
+ (let ((table (or (copy-sequence standard-display-table)
+ (make-display-table)))
+ (i 32))
+ ;; Nix out all the control chars...
+ (while (>= (setq i (1- i)) 0)
+ (aset table i [??]))
+ ;; ... but not newline and cr, of course. (cr is necessary for the
+ ;; selective display).
+ (aset table ?\n nil)
+ (aset table ?\r nil)
+ ;; We nix out any glyphs over 126 that are not set already.
+ (let ((i 256))
+ (while (>= (setq i (1- i)) 127)
+ ;; Only modify if the entry is nil.
+ (unless (aref table i)
+ (aset table i [??]))))
+ (setq buffer-display-table table)))
+
+(defun gnus-summary-setup-buffer (group)
+ "Initialize summary buffer."
+ (let ((buffer (concat "*Summary " group "*")))
+ (if (get-buffer buffer)
+ (progn
+ (set-buffer buffer)
+ (setq gnus-summary-buffer (current-buffer))
+ (not gnus-newsgroup-prepared))
+ ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
+ (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
+ (gnus-add-current-to-buffer-list)
+ (gnus-summary-mode group)
+ (when gnus-carpal
+ (gnus-carpal-setup-buffer 'summary))
+ (unless gnus-single-article-buffer
+ (make-local-variable 'gnus-article-buffer)
+ (make-local-variable 'gnus-article-current)
+ (make-local-variable 'gnus-original-article-buffer))
+ (setq gnus-newsgroup-name group)
+ t)))
+
+(defun gnus-set-global-variables ()
+ ;; Set the global equivalents of the summary buffer-local variables
+ ;; to the latest values they had. These reflect the summary buffer
+ ;; that was in action when the last article was fetched.
+ (when (eq major-mode 'gnus-summary-mode)
+ (setq gnus-summary-buffer (current-buffer))
+ (let ((name gnus-newsgroup-name)
+ (marked gnus-newsgroup-marked)
+ (unread gnus-newsgroup-unreads)
+ (headers gnus-current-headers)
+ (data gnus-newsgroup-data)
+ (summary gnus-summary-buffer)
+ (article-buffer gnus-article-buffer)
+ (original gnus-original-article-buffer)
+ (gac gnus-article-current)
+ (reffed gnus-reffed-article-number)
+ (score-file gnus-current-score-file))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (setq gnus-newsgroup-name name)
+ (setq gnus-newsgroup-marked marked)
+ (setq gnus-newsgroup-unreads unread)
+ (setq gnus-current-headers headers)
+ (setq gnus-newsgroup-data data)
+ (setq gnus-article-current gac)
+ (setq gnus-summary-buffer summary)
+ (setq gnus-article-buffer article-buffer)
+ (setq gnus-original-article-buffer original)
+ (setq gnus-reffed-article-number reffed)
+ (setq gnus-current-score-file score-file)
+ ;; The article buffer also has local variables.
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (set-buffer gnus-article-buffer)
+ (setq gnus-summary-buffer summary))))))
+
+(defun gnus-summary-article-unread-p (article)
+ "Say whether ARTICLE is unread or not."
+ (memq article gnus-newsgroup-unreads))
+
+(defun gnus-summary-first-article-p (&optional article)
+ "Return whether ARTICLE is the first article in the buffer."
+ (if (not (setq article (or article (gnus-summary-article-number))))
+ nil
+ (eq article (caar gnus-newsgroup-data))))
+
+(defun gnus-summary-last-article-p (&optional article)
+ "Return whether ARTICLE is the last article in the buffer."
+ (if (not (setq article (or article (gnus-summary-article-number))))
+ t ; All non-existent numbers are the last article. :-)
+ (not (cdr (gnus-data-find-list article)))))
+
+(defun gnus-make-thread-indent-array ()
+ (let ((n 200))
+ (unless (and gnus-thread-indent-array
+ (= gnus-thread-indent-level gnus-thread-indent-array-level))
+ (setq gnus-thread-indent-array (make-vector 201 "")
+ gnus-thread-indent-array-level gnus-thread-indent-level)
+ (while (>= n 0)
+ (aset gnus-thread-indent-array n
+ (make-string (* n gnus-thread-indent-level) ? ))
+ (setq n (1- n))))))
+
+(defun gnus-update-summary-mark-positions ()
+ "Compute where the summary marks are to go."
+ (save-excursion
+ (when (and gnus-summary-buffer
+ (get-buffer gnus-summary-buffer)
+ (buffer-name (get-buffer gnus-summary-buffer)))
+ (set-buffer gnus-summary-buffer))
+ (let ((gnus-replied-mark 129)
+ (gnus-score-below-mark 130)
+ (gnus-score-over-mark 130)
+ (gnus-download-mark 131)
+ (spec gnus-summary-line-format-spec)
+ thread gnus-visual pos)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (let ((gnus-summary-line-format-spec spec)
+ (gnus-newsgroup-downloadable '((0 . t))))
+ (gnus-summary-insert-line
+ [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
+ (goto-char (point-min))
+ (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
+ (- (point) 2)))))
+ (goto-char (point-min))
+ (push (cons 'replied (and (search-forward "\201" nil t)
+ (- (point) 2)))
+ pos)
+ (goto-char (point-min))
+ (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
+ pos)
+ (goto-char (point-min))
+ (push (cons 'download
+ (and (search-forward "\203" nil t) (- (point) 2)))
+ pos)))
+ (setq gnus-summary-mark-positions pos))))
+
+(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
+ "Insert a dummy root in the summary buffer."
+ (beginning-of-line)
+ (gnus-add-text-properties
+ (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
+ (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
+
+(defun gnus-summary-insert-line (gnus-tmp-header
+ gnus-tmp-level gnus-tmp-current
+ gnus-tmp-unread gnus-tmp-replied
+ gnus-tmp-expirable gnus-tmp-subject-or-nil
+ &optional gnus-tmp-dummy gnus-tmp-score
+ gnus-tmp-process)
+ (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
+ (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
+ (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
+ (gnus-tmp-score-char
+ (if (or (null gnus-summary-default-score)
+ (<= (abs (- gnus-tmp-score gnus-summary-default-score))
+ gnus-summary-zcore-fuzz))
+ ?
+ (if (< gnus-tmp-score gnus-summary-default-score)
+ gnus-score-below-mark gnus-score-over-mark)))
+ (gnus-tmp-replied
+ (cond (gnus-tmp-process gnus-process-mark)
+ ((memq gnus-tmp-current gnus-newsgroup-cached)
+ gnus-cached-mark)
+ (gnus-tmp-replied gnus-replied-mark)
+ ((memq gnus-tmp-current gnus-newsgroup-saved)
+ gnus-saved-mark)
+ (t gnus-unread-mark)))
+ (gnus-tmp-from (mail-header-from gnus-tmp-header))
+ (gnus-tmp-name
+ (cond
+ ((string-match "<[^>]+> *$" gnus-tmp-from)
+ (let ((beg (match-beginning 0)))
+ (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
+ (substring gnus-tmp-from (1+ (match-beginning 0))
+ (1- (match-end 0))))
+ (substring gnus-tmp-from 0 beg))))
+ ((string-match "(.+)" gnus-tmp-from)
+ (substring gnus-tmp-from
+ (1+ (match-beginning 0)) (1- (match-end 0))))
+ (t gnus-tmp-from)))
+ (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
+ (gnus-tmp-number (mail-header-number gnus-tmp-header))
+ (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
+ (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
+ (buffer-read-only nil))
+ (when (string= gnus-tmp-name "")
+ (setq gnus-tmp-name gnus-tmp-from))
+ (unless (numberp gnus-tmp-lines)
+ (setq gnus-tmp-lines 0))
+ (gnus-put-text-property
+ (point)
+ (progn (eval gnus-summary-line-format-spec) (point))
+ 'gnus-number gnus-tmp-number)
+ (when (gnus-visual-p 'summary-highlight 'highlight)
+ (forward-line -1)
+ (run-hooks 'gnus-summary-update-hook)
+ (forward-line 1))))
+
+(defun gnus-summary-update-line (&optional dont-update)
+ ;; Update summary line after change.
+ (when (and gnus-summary-default-score
+ (not gnus-summary-inhibit-highlight))
+ (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
+ (article (gnus-summary-article-number))
+ (score (gnus-summary-article-score article)))
+ (unless dont-update
+ (if (and gnus-summary-mark-below
+ (< (gnus-summary-article-score)
+ gnus-summary-mark-below))
+ ;; This article has a low score, so we mark it as read.
+ (when (memq article gnus-newsgroup-unreads)
+ (gnus-summary-mark-article-as-read gnus-low-score-mark))
+ (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
+ ;; This article was previously marked as read on account
+ ;; of a low score, but now it has risen, so we mark it as
+ ;; unread.
+ (gnus-summary-mark-article-as-unread gnus-unread-mark)))
+ (gnus-summary-update-mark
+ (if (or (null gnus-summary-default-score)
+ (<= (abs (- score gnus-summary-default-score))
+ gnus-summary-zcore-fuzz))
+ ?
+ (if (< score gnus-summary-default-score)
+ gnus-score-below-mark gnus-score-over-mark))
+ 'score))
+ ;; Do visual highlighting.
+ (when (gnus-visual-p 'summary-highlight 'highlight)
+ (run-hooks 'gnus-summary-update-hook)))))
+
+(defvar gnus-tmp-new-adopts nil)
+
+(defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
+ "Return the number of articles in THREAD.
+This may be 0 in some cases -- if none of the articles in
+the thread are to be displayed."
+ (let* ((number
+ ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
+ (cond
+ ((not (listp thread))
+ 1)
+ ((and (consp thread) (cdr thread))
+ (apply
+ '+ 1 (mapcar
+ 'gnus-summary-number-of-articles-in-thread (cdr thread))))
+ ((null thread)
+ 1)
+ ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
+ 1)
+ (t 0))))
+ (when (and level (zerop level) gnus-tmp-new-adopts)
+ (incf number
+ (apply '+ (mapcar
+ 'gnus-summary-number-of-articles-in-thread
+ gnus-tmp-new-adopts))))
+ (if char
+ (if (> number 1) gnus-not-empty-thread-mark
+ gnus-empty-thread-mark)
+ number)))
+
+(defun gnus-summary-set-local-parameters (group)
+ "Go through the local params of GROUP and set all variable specs in that list."
+ (let ((params (gnus-group-find-parameter group))
+ elem)
+ (while params
+ (setq elem (car params)
+ params (cdr params))
+ (and (consp elem) ; Has to be a cons.
+ (consp (cdr elem)) ; The cdr has to be a list.
+ (symbolp (car elem)) ; Has to be a symbol in there.
+ (not (memq (car elem)
+ '(quit-config to-address to-list to-group)))
+ (ignore-errors ; So we set it.
+ (make-local-variable (car elem))
+ (set (car elem) (eval (nth 1 elem))))))))
+
+(defun gnus-summary-read-group (group &optional show-all no-article
+ kill-buffer no-display)
+ "Start reading news in newsgroup GROUP.
+If SHOW-ALL is non-nil, already read articles are also listed.
+If NO-ARTICLE is non-nil, no article is selected initially.
+If NO-DISPLAY, don't generate a summary buffer."
+ (let (result)
+ (while (and group
+ (null (setq result
+ (let ((gnus-auto-select-next nil))
+ (or (gnus-summary-read-group-1
+ group show-all no-article
+ kill-buffer no-display)
+ (setq show-all nil)))))
+ (eq gnus-auto-select-next 'quietly))
+ (set-buffer gnus-group-buffer)
+ (if (not (equal group (gnus-group-group-name)))
+ (setq group (gnus-group-group-name))
+ (setq group nil)))
+ result))
+
+(defun gnus-summary-read-group-1 (group show-all no-article
+ kill-buffer no-display)
+ ;; Killed foreign groups can't be entered.
+ (when (and (not (gnus-group-native-p group))
+ (not (gnus-gethash group gnus-newsrc-hashtb)))
+ (error "Dead non-native groups can't be entered"))
+ (gnus-message 5 "Retrieving newsgroup: %s..." group)
+ (let* ((new-group (gnus-summary-setup-buffer group))
+ (quit-config (gnus-group-quit-config group))
+ (did-select (and new-group (gnus-select-newsgroup group show-all))))
+ (cond
+ ;; This summary buffer exists already, so we just select it.
+ ((not new-group)
+ (gnus-set-global-variables)
+ (when kill-buffer
+ (gnus-kill-or-deaden-summary kill-buffer))
+ (gnus-configure-windows 'summary 'force)
+ (gnus-set-mode-line 'summary)
+ (gnus-summary-position-point)
+ (message "")
+ t)
+ ;; We couldn't select this group.
+ ((null did-select)
+ (when (and (eq major-mode 'gnus-summary-mode)
+ (not (equal (current-buffer) kill-buffer)))
+ (kill-buffer (current-buffer))
+ (if (not quit-config)
+ (progn
+ (set-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group group)
+ (gnus-group-next-unread-group 1))
+ (gnus-handle-ephemeral-exit quit-config)))
+ (gnus-message 3 "Can't select group")
+ nil)
+ ;; The user did a `C-g' while prompting for number of articles,
+ ;; so we exit this group.
+ ((eq did-select 'quit)
+ (and (eq major-mode 'gnus-summary-mode)
+ (not (equal (current-buffer) kill-buffer))
+ (kill-buffer (current-buffer)))
+ (when kill-buffer
+ (gnus-kill-or-deaden-summary kill-buffer))
+ (if (not quit-config)
+ (progn
+ (set-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group group)
+ (gnus-group-next-unread-group 1)
+ (gnus-configure-windows 'group 'force))
+ (gnus-handle-ephemeral-exit quit-config))
+ ;; Finally signal the quit.
+ (signal 'quit nil))
+ ;; The group was successfully selected.
+ (t
+ (gnus-set-global-variables)
+ ;; Save the active value in effect when the group was entered.
+ (setq gnus-newsgroup-active
+ (gnus-copy-sequence
+ (gnus-active gnus-newsgroup-name)))
+ ;; You can change the summary buffer in some way with this hook.
+ (run-hooks 'gnus-select-group-hook)
+ ;; Set any local variables in the group parameters.
+ (gnus-summary-set-local-parameters gnus-newsgroup-name)
+ (gnus-update-format-specifications
+ nil 'summary 'summary-mode 'summary-dummy)
+ ;; Do score processing.
+ (when gnus-use-scoring
+ (gnus-possibly-score-headers))
+ ;; Check whether to fill in the gaps in the threads.
+ (when gnus-build-sparse-threads
+ (gnus-build-sparse-threads))
+ ;; Find the initial limit.
+ (if gnus-show-threads
+ (if show-all
+ (let ((gnus-newsgroup-dormant nil))
+ (gnus-summary-initial-limit show-all))
+ (gnus-summary-initial-limit show-all))
+ (setq gnus-newsgroup-limit
+ (mapcar
+ (lambda (header) (mail-header-number header))
+ gnus-newsgroup-headers)))
+ ;; Generate the summary buffer.
+ (unless no-display
+ (gnus-summary-prepare))
+ (when gnus-use-trees
+ (gnus-tree-open group)
+ (setq gnus-summary-highlight-line-function
+ 'gnus-tree-highlight-article))
+ ;; If the summary buffer is empty, but there are some low-scored
+ ;; articles or some excluded dormants, we include these in the
+ ;; buffer.
+ (when (and (zerop (buffer-size))
+ (not no-display))
+ (cond (gnus-newsgroup-dormant
+ (gnus-summary-limit-include-dormant))
+ ((and gnus-newsgroup-scored show-all)
+ (gnus-summary-limit-include-expunged t))))
+ ;; Function `gnus-apply-kill-file' must be called in this hook.
+ (run-hooks 'gnus-apply-kill-hook)
+ (if (and (zerop (buffer-size))
+ (not no-display))
+ (progn
+ ;; This newsgroup is empty.
+ (gnus-summary-catchup-and-exit nil t)
+ (gnus-message 6 "No unread news")
+ (when kill-buffer
+ (gnus-kill-or-deaden-summary kill-buffer))
+ ;; Return nil from this function.
+ nil)
+ ;; Hide conversation thread subtrees. We cannot do this in
+ ;; gnus-summary-prepare-hook since kill processing may not
+ ;; work with hidden articles.
+ (and gnus-show-threads
+ gnus-thread-hide-subtree
+ (gnus-summary-hide-all-threads))
+ ;; Show first unread article if requested.
+ (if (and (not no-article)
+ (not no-display)
+ gnus-newsgroup-unreads
+ gnus-auto-select-first)
+ (unless (if (eq gnus-auto-select-first 'best)
+ (gnus-summary-best-unread-article)
+ (gnus-summary-first-unread-article))
+ (gnus-configure-windows 'summary))
+ ;; Don't select any articles, just move point to the first
+ ;; article in the group.
+ (goto-char (point-min))
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ (gnus-configure-windows 'summary 'force))
+ (when kill-buffer
+ (gnus-kill-or-deaden-summary kill-buffer))
+ (when (get-buffer-window gnus-group-buffer t)
+ ;; Gotta use windows, because recenter does weird stuff if
+ ;; the current buffer ain't the displayed window.
+ (let ((owin (selected-window)))
+ (select-window (get-buffer-window gnus-group-buffer t))
+ (when (gnus-group-goto-group group)
+ (recenter))
+ (select-window owin)))
+ ;; Mark this buffer as "prepared".
+ (setq gnus-newsgroup-prepared t)
+ t)))))
+
+(defun gnus-summary-prepare ()
+ "Generate the summary buffer."
+ (interactive)
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (setq gnus-newsgroup-data nil
+ gnus-newsgroup-data-reverse nil)
+ (run-hooks 'gnus-summary-generate-hook)
+ ;; Generate the buffer, either with threads or without.
+ (when gnus-newsgroup-headers
+ (gnus-summary-prepare-threads
+ (if gnus-show-threads
+ (gnus-sort-gathered-threads
+ (funcall gnus-summary-thread-gathering-function
+ (gnus-sort-threads
+ (gnus-cut-threads (gnus-make-threads)))))
+ ;; Unthreaded display.
+ (gnus-sort-articles gnus-newsgroup-headers))))
+ (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
+ ;; Call hooks for modifying summary buffer.
+ (goto-char (point-min))
+ (run-hooks 'gnus-summary-prepare-hook)))
+
+(defsubst gnus-general-simplify-subject (subject)
+ "Simply subject by the same rules as gnus-gather-threads-by-subject."
+ (setq subject
+ (cond
+ ;; Truncate the subject.
+ (gnus-simplify-subject-functions
+ (gnus-map-function gnus-simplify-subject-functions subject))
+ ((numberp gnus-summary-gather-subject-limit)
+ (setq subject (gnus-simplify-subject-re subject))
+ (if (> (length subject) gnus-summary-gather-subject-limit)
+ (substring subject 0 gnus-summary-gather-subject-limit)
+ subject))
+ ;; Fuzzily simplify it.
+ ((eq 'fuzzy gnus-summary-gather-subject-limit)
+ (gnus-simplify-subject-fuzzy subject))
+ ;; Just remove the leading "Re:".
+ (t
+ (gnus-simplify-subject-re subject))))
+
+ (if (and gnus-summary-gather-exclude-subject
+ (string-match gnus-summary-gather-exclude-subject subject))
+ nil ; This article shouldn't be gathered
+ subject))
+
+(defun gnus-summary-simplify-subject-query ()
+ "Query where the respool algorithm would put this article."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (message (gnus-general-simplify-subject (gnus-summary-article-subject))))
+
+(defun gnus-gather-threads-by-subject (threads)
+ "Gather threads by looking at Subject headers."
+ (if (not gnus-summary-make-false-root)
+ threads
+ (let ((hashtb (gnus-make-hashtable 1024))
+ (prev threads)
+ (result threads)
+ subject hthread whole-subject)
+ (while threads
+ (setq subject (gnus-general-simplify-subject
+ (setq whole-subject (mail-header-subject
+ (caar threads)))))
+ (when subject
+ (if (setq hthread (gnus-gethash subject hashtb))
+ (progn
+ ;; We enter a dummy root into the thread, if we
+ ;; haven't done that already.
+ (unless (stringp (caar hthread))
+ (setcar hthread (list whole-subject (car hthread))))
+ ;; We add this new gathered thread to this gathered
+ ;; thread.
+ (setcdr (car hthread)
+ (nconc (cdar hthread) (list (car threads))))
+ ;; Remove it from the list of threads.
+ (setcdr prev (cdr threads))
+ (setq threads prev))
+ ;; Enter this thread into the hash table.
+ (gnus-sethash subject threads hashtb)))
+ (setq prev threads)
+ (setq threads (cdr threads)))
+ result)))
+
+(defun gnus-gather-threads-by-references (threads)
+ "Gather threads by looking at References headers."
+ (let ((idhashtb (gnus-make-hashtable 1024))
+ (thhashtb (gnus-make-hashtable 1024))
+ (prev threads)
+ (result threads)
+ ids references id gthread gid entered ref)
+ (while threads
+ (when (setq references (mail-header-references (caar threads)))
+ (setq id (mail-header-id (caar threads))
+ ids (gnus-split-references references)
+ entered nil)
+ (while (setq ref (pop ids))
+ (setq ids (delete ref ids))
+ (if (not (setq gid (gnus-gethash ref idhashtb)))
+ (progn
+ (gnus-sethash ref id idhashtb)
+ (gnus-sethash id threads thhashtb))
+ (setq gthread (gnus-gethash gid thhashtb))
+ (unless entered
+ ;; We enter a dummy root into the thread, if we
+ ;; haven't done that already.
+ (unless (stringp (caar gthread))
+ (setcar gthread (list (mail-header-subject (caar gthread))
+ (car gthread))))
+ ;; We add this new gathered thread to this gathered
+ ;; thread.
+ (setcdr (car gthread)
+ (nconc (cdar gthread) (list (car threads)))))
+ ;; Add it into the thread hash table.
+ (gnus-sethash id gthread thhashtb)
+ (setq entered t)
+ ;; Remove it from the list of threads.
+ (setcdr prev (cdr threads))
+ (setq threads prev))))
+ (setq prev threads)
+ (setq threads (cdr threads)))
+ result))
+
+(defun gnus-sort-gathered-threads (threads)
+ "Sort subtreads inside each gathered thread by article number."
+ (let ((result threads))
+ (while threads
+ (when (stringp (caar threads))
+ (setcdr (car threads)
+ (sort (cdar threads) 'gnus-thread-sort-by-number)))
+ (setq threads (cdr threads)))
+ result))
+
+(defun gnus-thread-loop-p (root thread)
+ "Say whether ROOT is in THREAD."
+ (let ((stack (list thread))
+ (infloop 0)
+ th)
+ (while (setq thread (pop stack))
+ (setq th (cdr thread))
+ (while (and th
+ (not (eq (caar th) root)))
+ (pop th))
+ (if th
+ ;; We have found a loop.
+ (let (ref-dep)
+ (setcdr thread (delq (car th) (cdr thread)))
+ (if (boundp (setq ref-dep (intern "none"
+ gnus-newsgroup-dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (car th))))
+ (set ref-dep (list nil (car th))))
+ (setq infloop 1
+ stack nil))
+ ;; Push all the subthreads onto the stack.
+ (push (cdr thread) stack)))
+ infloop))
+
+(defun gnus-make-threads ()
+ "Go through the dependency hashtb and find the roots. Return all threads."
+ (let (threads)
+ (while (catch 'infloop
+ (mapatoms
+ (lambda (refs)
+ ;; Deal with self-referencing References loops.
+ (when (and (car (symbol-value refs))
+ (not (zerop
+ (apply
+ '+
+ (mapcar
+ (lambda (thread)
+ (gnus-thread-loop-p
+ (car (symbol-value refs)) thread))
+ (cdr (symbol-value refs)))))))
+ (setq threads nil)
+ (throw 'infloop t))
+ (unless (car (symbol-value refs))
+ ;; These threads do not refer back to any other articles,
+ ;; so they're roots.
+ (setq threads (append (cdr (symbol-value refs)) threads))))
+ gnus-newsgroup-dependencies)))
+ threads))
+
+(defun gnus-build-sparse-threads ()
+ (let ((headers gnus-newsgroup-headers)
+ (deps gnus-newsgroup-dependencies)
+ header references generation relations
+ cthread subject child end pthread relation new-child)
+ ;; First we create an alist of generations/relations, where
+ ;; generations is how much we trust the relation, and the relation
+ ;; is parent/child.
+ (gnus-message 7 "Making sparse threads...")
+ (save-excursion
+ (nnheader-set-temp-buffer " *gnus sparse threads*")
+ (while (setq header (pop headers))
+ (when (and (setq references (mail-header-references header))
+ (not (string= references "")))
+ (insert references)
+ (setq child (mail-header-id header)
+ subject (mail-header-subject header))
+ (setq generation 0)
+ (while (search-backward ">" nil t)
+ (setq end (1+ (point)))
+ (when (search-backward "<" nil t)
+ (unless (string= (setq new-child (buffer-substring (point) end))
+ child)
+ (push (list (incf generation)
+ child (setq child new-child)
+ subject)
+ relations))))
+ (push (list (1+ generation) child nil subject) relations)
+ (erase-buffer)))
+ (kill-buffer (current-buffer)))
+ ;; Sort over trustworthiness.
+ (setq relations (sort relations 'car-less-than-car))
+ (while (setq relation (pop relations))
+ (when (if (boundp (setq cthread (intern (cadr relation) deps)))
+ (unless (car (symbol-value cthread))
+ ;; Make this article the parent of these threads.
+ (setcar (symbol-value cthread)
+ (vector gnus-reffed-article-number
+ (cadddr relation)
+ "" ""
+ (cadr relation)
+ (or (caddr relation) "") 0 0 "")))
+ (set cthread (list (vector gnus-reffed-article-number
+ (cadddr relation)
+ "" "" (cadr relation)
+ (or (caddr relation) "") 0 0 ""))))
+ (push gnus-reffed-article-number gnus-newsgroup-limit)
+ (push gnus-reffed-article-number gnus-newsgroup-sparse)
+ (push (cons gnus-reffed-article-number gnus-sparse-mark)
+ gnus-newsgroup-reads)
+ (decf gnus-reffed-article-number)
+ ;; Make this new thread the child of its parent.
+ (if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
+ (setcdr (symbol-value pthread)
+ (nconc (cdr (symbol-value pthread))
+ (list (symbol-value cthread))))
+ (set pthread (list nil (symbol-value cthread))))))
+ (gnus-message 7 "Making sparse threads...done")))
+
+(defun gnus-build-old-threads ()
+ ;; Look at all the articles that refer back to old articles, and
+ ;; fetch the headers for the articles that aren't there. This will
+ ;; build complete threads - if the roots haven't been expired by the
+ ;; server, that is.
+ (let (id heads)
+ (mapatoms
+ (lambda (refs)
+ (when (not (car (symbol-value refs)))
+ (setq heads (cdr (symbol-value refs)))
+ (while heads
+ (if (memq (mail-header-number (caar heads))
+ gnus-newsgroup-dormant)
+ (setq heads (cdr heads))
+ (setq id (symbol-name refs))
+ (while (and (setq id (gnus-build-get-header id))
+ (not (car (gnus-gethash
+ id gnus-newsgroup-dependencies)))))
+ (setq heads nil)))))
+ gnus-newsgroup-dependencies)))
+
+(defun gnus-build-get-header (id)
+ ;; Look through the buffer of NOV lines and find the header to
+ ;; ID. Enter this line into the dependencies hash table, and return
+ ;; the id of the parent article (if any).
+ (let ((deps gnus-newsgroup-dependencies)
+ found header)
+ (prog1
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (while (and (not found)
+ (search-forward id nil t))
+ (beginning-of-line)
+ (setq found (looking-at
+ (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
+ (regexp-quote id))))
+ (or found (beginning-of-line 2)))
+ (when found
+ (beginning-of-line)
+ (and
+ (setq header (gnus-nov-parse-line
+ (read (current-buffer)) deps))
+ (gnus-parent-id (mail-header-references header))))))
+ (when header
+ (let ((number (mail-header-number header)))
+ (push number gnus-newsgroup-limit)
+ (push header gnus-newsgroup-headers)
+ (if (memq number gnus-newsgroup-unselected)
+ (progn
+ (push number gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unselected
+ (delq number gnus-newsgroup-unselected)))
+ (push number gnus-newsgroup-ancient)))))))
+
+(defun gnus-build-all-threads ()
+ "Read all the headers."
+ (let ((deps gnus-newsgroup-dependencies)
+ (gnus-summary-ignore-duplicates t)
+ found header article)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (ignore-errors
+ (setq article (read (current-buffer)))
+ (setq header (gnus-nov-parse-line article deps)))
+ (when header
+ (push header gnus-newsgroup-headers)
+ (if (memq (setq article (mail-header-number header))
+ gnus-newsgroup-unselected)
+ (progn
+ (push article gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unselected
+ (delq article gnus-newsgroup-unselected)))
+ (push article gnus-newsgroup-ancient))
+ (forward-line 1)))))))
+
+(defun gnus-summary-update-article-line (article header)
+ "Update the line for ARTICLE using HEADERS."
+ (let* ((id (mail-header-id header))
+ (thread (gnus-id-to-thread id)))
+ (unless thread
+ (error "Article in no thread"))
+ ;; Update the thread.
+ (setcar thread header)
+ (gnus-summary-goto-subject article)
+ (let* ((datal (gnus-data-find-list article))
+ (data (car datal))
+ (length (when (cdr datal)
+ (- (gnus-data-pos data)
+ (gnus-data-pos (cadr datal)))))
+ (buffer-read-only nil)
+ (level (gnus-summary-thread-level)))
+ (gnus-delete-line)
+ (gnus-summary-insert-line
+ header level nil (gnus-article-mark article)
+ (memq article gnus-newsgroup-replied)
+ (memq article gnus-newsgroup-expirable)
+ ;; Only insert the Subject string when it's different
+ ;; from the previous Subject string.
+ (if (gnus-subject-equal
+ (condition-case ()
+ (mail-header-subject
+ (gnus-data-header
+ (cadr
+ (gnus-data-find-list
+ article
+ (gnus-data-list t)))))
+ ;; Error on the side of excessive subjects.
+ (error ""))
+ (mail-header-subject header))
+ ""
+ (mail-header-subject header))
+ nil (cdr (assq article gnus-newsgroup-scored))
+ (memq article gnus-newsgroup-processable))
+ (when length
+ (gnus-data-update-list
+ (cdr datal) (- length (- (gnus-data-pos data) (point))))))))
+
+(defun gnus-summary-update-article (article &optional iheader)
+ "Update ARTICLE in the summary buffer."
+ (set-buffer gnus-summary-buffer)
+ (let* ((header (or iheader (gnus-summary-article-header article)))
+ (id (mail-header-id header))
+ (data (gnus-data-find article))
+ (thread (gnus-id-to-thread id))
+ (references (mail-header-references header))
+ (parent
+ (gnus-id-to-thread
+ (or (gnus-parent-id
+ (when (and references
+ (not (equal "" references)))
+ references))
+ "none")))
+ (buffer-read-only nil)
+ (old (car thread))
+ (number (mail-header-number header))
+ pos)
+ (when thread
+ ;; !!! Should this be in or not?
+ (unless iheader
+ (setcar thread nil))
+ (when parent
+ (delq thread parent))
+ (if (gnus-summary-insert-subject id header iheader)
+ ;; Set the (possibly) new article number in the data structure.
+ (gnus-data-set-number data (gnus-id-to-article id))
+ (setcar thread old)
+ nil))))
+
+(defun gnus-rebuild-thread (id)
+ "Rebuild the thread containing ID."
+ (let ((buffer-read-only nil)
+ old-pos current thread data)
+ (if (not gnus-show-threads)
+ (setq thread (list (car (gnus-id-to-thread id))))
+ ;; Get the thread this article is part of.
+ (setq thread (gnus-remove-thread id)))
+ (setq old-pos (gnus-point-at-bol))
+ (setq current (save-excursion
+ (and (zerop (forward-line -1))
+ (gnus-summary-article-number))))
+ ;; If this is a gathered thread, we have to go some re-gathering.
+ (when (stringp (car thread))
+ (let ((subject (car thread))
+ roots thr)
+ (setq thread (cdr thread))
+ (while thread
+ (unless (memq (setq thr (gnus-id-to-thread
+ (gnus-root-id
+ (mail-header-id (caar thread)))))
+ roots)
+ (push thr roots))
+ (setq thread (cdr thread)))
+ ;; We now have all (unique) roots.
+ (if (= (length roots) 1)
+ ;; All the loose roots are now one solid root.
+ (setq thread (car roots))
+ (setq thread (cons subject (gnus-sort-threads roots))))))
+ (let (threads)
+ ;; We then insert this thread into the summary buffer.
+ (let (gnus-newsgroup-data gnus-newsgroup-threads)
+ (if gnus-show-threads
+ (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
+ (gnus-summary-prepare-unthreaded thread))
+ (setq data (nreverse gnus-newsgroup-data))
+ (setq threads gnus-newsgroup-threads))
+ ;; We splice the new data into the data structure.
+ (gnus-data-enter-list current data (- (point) old-pos))
+ (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
+
+(defun gnus-number-to-header (number)
+ "Return the header for article NUMBER."
+ (let ((headers gnus-newsgroup-headers))
+ (while (and headers
+ (not (= number (mail-header-number (car headers)))))
+ (pop headers))
+ (when headers
+ (car headers))))
+
+(defun gnus-parent-headers (headers &optional generation)
+ "Return the headers of the GENERATIONeth parent of HEADERS."
+ (unless generation
+ (setq generation 1))
+ (let ((parent t)
+ references)
+ (while (and parent headers (not (zerop generation)))
+ (setq references (mail-header-references headers))
+ (when (and references
+ (setq parent (gnus-parent-id references))
+ (setq headers (car (gnus-id-to-thread parent))))
+ (decf generation)))
+ headers))
+
+(defun gnus-id-to-thread (id)
+ "Return the (sub-)thread where ID appears."
+ (gnus-gethash id gnus-newsgroup-dependencies))
+
+(defun gnus-id-to-article (id)
+ "Return the article number of ID."
+ (let ((thread (gnus-id-to-thread id)))
+ (when (and thread
+ (car thread))
+ (mail-header-number (car thread)))))
+
+(defun gnus-id-to-header (id)
+ "Return the article headers of ID."
+ (car (gnus-id-to-thread id)))
+
+(defun gnus-article-displayed-root-p (article)
+ "Say whether ARTICLE is a root(ish) article."
+ (let ((level (gnus-summary-thread-level article))
+ (refs (mail-header-references (gnus-summary-article-header article)))
+ particle)
+ (cond
+ ((null level) nil)
+ ((zerop level) t)
+ ((null refs) t)
+ ((null (gnus-parent-id refs)) t)
+ ((and (= 1 level)
+ (null (setq particle (gnus-id-to-article
+ (gnus-parent-id refs))))
+ (null (gnus-summary-thread-level particle)))))))
+
+(defun gnus-root-id (id)
+ "Return the id of the root of the thread where ID appears."
+ (let (last-id prev)
+ (while (and id (setq prev (car (gnus-gethash
+ id gnus-newsgroup-dependencies))))
+ (setq last-id id
+ id (gnus-parent-id (mail-header-references prev))))
+ last-id))
+
+(defun gnus-articles-in-thread (thread)
+ "Return the list of articles in THREAD."
+ (cons (mail-header-number (car thread))
+ (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread)))))
+
+(defun gnus-remove-thread (id &optional dont-remove)
+ "Remove the thread that has ID in it."
+ (let ((dep gnus-newsgroup-dependencies)
+ headers thread last-id)
+ ;; First go up in this thread until we find the root.
+ (setq last-id (gnus-root-id id))
+ (setq headers (list (car (gnus-id-to-thread last-id))
+ (caadr (gnus-id-to-thread last-id))))
+ ;; We have now found the real root of this thread. It might have
+ ;; been gathered into some loose thread, so we have to search
+ ;; through the threads to find the thread we wanted.
+ (let ((threads gnus-newsgroup-threads)
+ sub)
+ (while threads
+ (setq sub (car threads))
+ (if (stringp (car sub))
+ ;; This is a gathered thread, so we look at the roots
+ ;; below it to find whether this article is in this
+ ;; gathered root.
+ (progn
+ (setq sub (cdr sub))
+ (while sub
+ (when (member (caar sub) headers)
+ (setq thread (car threads)
+ threads nil
+ sub nil))
+ (setq sub (cdr sub))))
+ ;; It's an ordinary thread, so we check it.
+ (when (eq (car sub) (car headers))
+ (setq thread sub
+ threads nil)))
+ (setq threads (cdr threads)))
+ ;; If this article is in no thread, then it's a root.
+ (if thread
+ (unless dont-remove
+ (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
+ (setq thread (gnus-gethash last-id dep)))
+ (when thread
+ (prog1
+ thread ; We return this thread.
+ (unless dont-remove
+ (if (stringp (car thread))
+ (progn
+ ;; If we use dummy roots, then we have to remove the
+ ;; dummy root as well.
+ (when (eq gnus-summary-make-false-root 'dummy)
+ (gnus-delete-line)
+ (gnus-data-compute-positions))
+ (setq thread (cdr thread))
+ (while thread
+ (gnus-remove-thread-1 (car thread))
+ (setq thread (cdr thread))))
+ (gnus-remove-thread-1 thread))))))))
+
+(defun gnus-remove-thread-1 (thread)
+ "Remove the thread THREAD recursively."
+ (let ((number (mail-header-number (pop thread)))
+ d)
+ (setq thread (reverse thread))
+ (while thread
+ (gnus-remove-thread-1 (pop thread)))
+ (when (setq d (gnus-data-find number))
+ (goto-char (gnus-data-pos d))
+ (gnus-data-remove
+ number
+ (- (gnus-point-at-bol)
+ (prog1
+ (1+ (gnus-point-at-eol))
+ (gnus-delete-line)))))))
+
+(defun gnus-sort-threads (threads)
+ "Sort THREADS."
+ (if (not gnus-thread-sort-functions)
+ threads
+ (gnus-message 7 "Sorting threads...")
+ (prog1
+ (sort threads (gnus-make-sort-function gnus-thread-sort-functions))
+ (gnus-message 7 "Sorting threads...done"))))
+
+(defun gnus-sort-articles (articles)
+ "Sort ARTICLES."
+ (when gnus-article-sort-functions
+ (gnus-message 7 "Sorting articles...")
+ (prog1
+ (setq gnus-newsgroup-headers
+ (sort articles (gnus-make-sort-function
+ gnus-article-sort-functions)))
+ (gnus-message 7 "Sorting articles...done"))))
+
+;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
+(defmacro gnus-thread-header (thread)
+ ;; Return header of first article in THREAD.
+ ;; Note that THREAD must never, ever be anything else than a variable -
+ ;; using some other form will lead to serious barfage.
+ (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
+ ;; (8% speedup to gnus-summary-prepare, just for fun :-)
+ (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
+ (vector thread) 2))
+
+(defsubst gnus-article-sort-by-number (h1 h2)
+ "Sort articles by article number."
+ (< (mail-header-number h1)
+ (mail-header-number h2)))
+
+(defun gnus-thread-sort-by-number (h1 h2)
+ "Sort threads by root article number."
+ (gnus-article-sort-by-number
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
+(defsubst gnus-article-sort-by-lines (h1 h2)
+ "Sort articles by article Lines header."
+ (< (mail-header-lines h1)
+ (mail-header-lines h2)))
+
+(defun gnus-thread-sort-by-lines (h1 h2)
+ "Sort threads by root article Lines header."
+ (gnus-article-sort-by-lines
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
+(defsubst gnus-article-sort-by-author (h1 h2)
+ "Sort articles by root author."
+ (string-lessp
+ (let ((extract (funcall
+ gnus-extract-address-components
+ (mail-header-from h1))))
+ (or (car extract) (cadr extract) ""))
+ (let ((extract (funcall
+ gnus-extract-address-components
+ (mail-header-from h2))))
+ (or (car extract) (cadr extract) ""))))
+
+(defun gnus-thread-sort-by-author (h1 h2)
+ "Sort threads by root author."
+ (gnus-article-sort-by-author
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
+(defsubst gnus-article-sort-by-subject (h1 h2)
+ "Sort articles by root subject."
+ (string-lessp
+ (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
+ (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
+
+(defun gnus-thread-sort-by-subject (h1 h2)
+ "Sort threads by root subject."
+ (gnus-article-sort-by-subject
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
+(defsubst gnus-article-sort-by-date (h1 h2)
+ "Sort articles by root article date."
+ (gnus-time-less
+ (gnus-date-get-time (mail-header-date h1))
+ (gnus-date-get-time (mail-header-date h2))))
+
+(defun gnus-thread-sort-by-date (h1 h2)
+ "Sort threads by root article date."
+ (gnus-article-sort-by-date
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
+(defsubst gnus-article-sort-by-score (h1 h2)
+ "Sort articles by root article score.
+Unscored articles will be counted as having a score of zero."
+ (> (or (cdr (assq (mail-header-number h1)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0)
+ (or (cdr (assq (mail-header-number h2)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0)))
+
+(defun gnus-thread-sort-by-score (h1 h2)
+ "Sort threads by root article score."
+ (gnus-article-sort-by-score
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
+(defun gnus-thread-sort-by-total-score (h1 h2)
+ "Sort threads by the sum of all scores in the thread.
+Unscored articles will be counted as having a score of zero."
+ (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
+
+(defun gnus-thread-total-score (thread)
+ ;; This function find the total score of THREAD.
+ (cond ((null thread)
+ 0)
+ ((consp thread)
+ (if (stringp (car thread))
+ (apply gnus-thread-score-function 0
+ (mapcar 'gnus-thread-total-score-1 (cdr thread)))
+ (gnus-thread-total-score-1 thread)))
+ (t
+ (gnus-thread-total-score-1 (list thread)))))
+
+(defun gnus-thread-total-score-1 (root)
+ ;; This function find the total score of the thread below ROOT.
+ (setq root (car root))
+ (apply gnus-thread-score-function
+ (or (append
+ (mapcar 'gnus-thread-total-score
+ (cdr (gnus-gethash (mail-header-id root)
+ gnus-newsgroup-dependencies)))
+ (when (> (mail-header-number root) 0)
+ (list (or (cdr (assq (mail-header-number root)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0))))
+ (list gnus-summary-default-score)
+ '(0))))
+
+;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
+(defvar gnus-tmp-prev-subject nil)
+(defvar gnus-tmp-false-parent nil)
+(defvar gnus-tmp-root-expunged nil)
+(defvar gnus-tmp-dummy-line nil)
+
+(defun gnus-summary-prepare-threads (threads)
+ "Prepare summary buffer from THREADS and indentation LEVEL.
+THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
+or a straight list of headers."
+ (gnus-message 7 "Generating summary...")
+
+ (setq gnus-newsgroup-threads threads)
+ (beginning-of-line)
+
+ (let ((gnus-tmp-level 0)
+ (default-score (or gnus-summary-default-score 0))
+ (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
+ thread number subject stack state gnus-tmp-gathered beg-match
+ new-roots gnus-tmp-new-adopts thread-end
+ gnus-tmp-header gnus-tmp-unread
+ gnus-tmp-replied gnus-tmp-subject-or-nil
+ gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
+ gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
+ gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
+
+ (setq gnus-tmp-prev-subject nil)
+
+ (if (vectorp (car threads))
+ ;; If this is a straight (sic) list of headers, then a
+ ;; threaded summary display isn't required, so we just create
+ ;; an unthreaded one.
+ (gnus-summary-prepare-unthreaded threads)
+
+ ;; Do the threaded display.
+
+ (while (or threads stack gnus-tmp-new-adopts new-roots)
+
+ (if (and (= gnus-tmp-level 0)
+ (not (setq gnus-tmp-dummy-line nil))
+ (or (not stack)
+ (= (caar stack) 0))
+ (not gnus-tmp-false-parent)
+ (or gnus-tmp-new-adopts new-roots))
+ (if gnus-tmp-new-adopts
+ (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
+ thread (list (car gnus-tmp-new-adopts))
+ gnus-tmp-header (caar thread)
+ gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
+ (when new-roots
+ (setq thread (list (car new-roots))
+ gnus-tmp-header (caar thread)
+ new-roots (cdr new-roots))))
+
+ (if threads
+ ;; If there are some threads, we do them before the
+ ;; threads on the stack.
+ (setq thread threads
+ gnus-tmp-header (caar thread))
+ ;; There were no current threads, so we pop something off
+ ;; the stack.
+ (setq state (car stack)
+ gnus-tmp-level (car state)
+ thread (cdr state)
+ stack (cdr stack)
+ gnus-tmp-header (caar thread))))
+
+ (setq gnus-tmp-false-parent nil)
+ (setq gnus-tmp-root-expunged nil)
+ (setq thread-end nil)
+
+ (if (stringp gnus-tmp-header)
+ ;; The header is a dummy root.
+ (cond
+ ((eq gnus-summary-make-false-root 'adopt)
+ ;; We let the first article adopt the rest.
+ (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
+ (cddar thread)))
+ (setq gnus-tmp-gathered
+ (nconc (mapcar
+ (lambda (h) (mail-header-number (car h)))
+ (cddar thread))
+ gnus-tmp-gathered))
+ (setq thread (cons (list (caar thread)
+ (cadar thread))
+ (cdr thread)))
+ (setq gnus-tmp-level -1
+ gnus-tmp-false-parent t))
+ ((eq gnus-summary-make-false-root 'empty)
+ ;; We print adopted articles with empty subject fields.
+ (setq gnus-tmp-gathered
+ (nconc (mapcar
+ (lambda (h) (mail-header-number (car h)))
+ (cddar thread))
+ gnus-tmp-gathered))
+ (setq gnus-tmp-level -1))
+ ((eq gnus-summary-make-false-root 'dummy)
+ ;; We remember that we probably want to output a dummy
+ ;; root.
+ (setq gnus-tmp-dummy-line gnus-tmp-header)
+ (setq gnus-tmp-prev-subject gnus-tmp-header))
+ (t
+ ;; We do not make a root for the gathered
+ ;; sub-threads at all.
+ (setq gnus-tmp-level -1)))
+
+ (setq number (mail-header-number gnus-tmp-header)
+ subject (mail-header-subject gnus-tmp-header))
+
+ (cond
+ ;; If the thread has changed subject, we might want to make
+ ;; this subthread into a root.
+ ((and (null gnus-thread-ignore-subject)
+ (not (zerop gnus-tmp-level))
+ gnus-tmp-prev-subject
+ (not (inline
+ (gnus-subject-equal gnus-tmp-prev-subject subject))))
+ (setq new-roots (nconc new-roots (list (car thread)))
+ thread-end t
+ gnus-tmp-header nil))
+ ;; If the article lies outside the current limit,
+ ;; then we do not display it.
+ ((not (memq number gnus-newsgroup-limit))
+ (setq gnus-tmp-gathered
+ (nconc (mapcar
+ (lambda (h) (mail-header-number (car h)))
+ (cdar thread))
+ gnus-tmp-gathered))
+ (setq gnus-tmp-new-adopts (if (cdar thread)
+ (append gnus-tmp-new-adopts
+ (cdar thread))
+ gnus-tmp-new-adopts)
+ thread-end t
+ gnus-tmp-header nil)
+ (when (zerop gnus-tmp-level)
+ (setq gnus-tmp-root-expunged t)))
+ ;; Perhaps this article is to be marked as read?
+ ((and gnus-summary-mark-below
+ (< (or (cdr (assq number gnus-newsgroup-scored))
+ default-score)
+ gnus-summary-mark-below)
+ ;; Don't touch sparse articles.
+ (not (gnus-summary-article-sparse-p number))
+ (not (gnus-summary-article-ancient-p number)))
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ (if gnus-newsgroup-auto-expire
+ (push number gnus-newsgroup-expirable)
+ (push (cons number gnus-low-score-mark)
+ gnus-newsgroup-reads))))
+
+ (when gnus-tmp-header
+ ;; We may have an old dummy line to output before this
+ ;; article.
+ (when gnus-tmp-dummy-line
+ (gnus-summary-insert-dummy-line
+ gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
+ (setq gnus-tmp-dummy-line nil))
+
+ ;; Compute the mark.
+ (setq gnus-tmp-unread (gnus-article-mark number))
+
+ (push (gnus-data-make number gnus-tmp-unread (1+ (point))
+ gnus-tmp-header gnus-tmp-level)
+ gnus-newsgroup-data)
+
+ ;; Actually insert the line.
+ (setq
+ gnus-tmp-subject-or-nil
+ (cond
+ ((and gnus-thread-ignore-subject
+ gnus-tmp-prev-subject
+ (not (inline (gnus-subject-equal
+ gnus-tmp-prev-subject subject))))
+ subject)
+ ((zerop gnus-tmp-level)
+ (if (and (eq gnus-summary-make-false-root 'empty)
+ (memq number gnus-tmp-gathered)
+ gnus-tmp-prev-subject
+ (inline (gnus-subject-equal
+ gnus-tmp-prev-subject subject)))
+ gnus-summary-same-subject
+ subject))
+ (t gnus-summary-same-subject)))
+ (if (and (eq gnus-summary-make-false-root 'adopt)
+ (= gnus-tmp-level 1)
+ (memq number gnus-tmp-gathered))
+ (setq gnus-tmp-opening-bracket ?\<
+ gnus-tmp-closing-bracket ?\>)
+ (setq gnus-tmp-opening-bracket ?\[
+ gnus-tmp-closing-bracket ?\]))
+ (setq
+ gnus-tmp-indentation
+ (aref gnus-thread-indent-array gnus-tmp-level)
+ gnus-tmp-lines (mail-header-lines gnus-tmp-header)
+ gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
+ gnus-summary-default-score 0)
+ gnus-tmp-score-char
+ (if (or (null gnus-summary-default-score)
+ (<= (abs (- gnus-tmp-score gnus-summary-default-score))
+ gnus-summary-zcore-fuzz))
+ ?
+ (if (< gnus-tmp-score gnus-summary-default-score)
+ gnus-score-below-mark gnus-score-over-mark))
+ gnus-tmp-replied
+ (cond ((memq number gnus-newsgroup-processable)
+ gnus-process-mark)
+ ((memq number gnus-newsgroup-cached)
+ gnus-cached-mark)
+ ((memq number gnus-newsgroup-replied)
+ gnus-replied-mark)
+ ((memq number gnus-newsgroup-saved)
+ gnus-saved-mark)
+ (t gnus-unread-mark))
+ gnus-tmp-from (mail-header-from gnus-tmp-header)
+ gnus-tmp-name
+ (cond
+ ((string-match "<[^>]+> *$" gnus-tmp-from)
+ (setq beg-match (match-beginning 0))
+ (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
+ (substring gnus-tmp-from (1+ (match-beginning 0))
+ (1- (match-end 0))))
+ (substring gnus-tmp-from 0 beg-match)))
+ ((string-match "(.+)" gnus-tmp-from)
+ (substring gnus-tmp-from
+ (1+ (match-beginning 0)) (1- (match-end 0))))
+ (t gnus-tmp-from)))
+ (when (string= gnus-tmp-name "")
+ (setq gnus-tmp-name gnus-tmp-from))
+ (unless (numberp gnus-tmp-lines)
+ (setq gnus-tmp-lines 0))
+ (gnus-put-text-property
+ (point)
+ (progn (eval gnus-summary-line-format-spec) (point))
+ 'gnus-number number)
+ (when gnus-visual-p
+ (forward-line -1)
+ (run-hooks 'gnus-summary-update-hook)
+ (forward-line 1))
+
+ (setq gnus-tmp-prev-subject subject)))
+
+ (when (nth 1 thread)
+ (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
+ (incf gnus-tmp-level)
+ (setq threads (if thread-end nil (cdar thread)))
+ (unless threads
+ (setq gnus-tmp-level 0)))))
+ (gnus-message 7 "Generating summary...done"))
+
+(defun gnus-summary-prepare-unthreaded (headers)
+ "Generate an unthreaded summary buffer based on HEADERS."
+ (let (header number mark)
+
+ (beginning-of-line)
+
+ (while headers
+ ;; We may have to root out some bad articles...
+ (when (memq (setq number (mail-header-number
+ (setq header (pop headers))))
+ gnus-newsgroup-limit)
+ ;; Mark article as read when it has a low score.
+ (when (and gnus-summary-mark-below
+ (< (or (cdr (assq number gnus-newsgroup-scored))
+ gnus-summary-default-score 0)
+ gnus-summary-mark-below)
+ (not (gnus-summary-article-ancient-p number)))
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ (if gnus-newsgroup-auto-expire
+ (push number gnus-newsgroup-expirable)
+ (push (cons number gnus-low-score-mark)
+ gnus-newsgroup-reads)))
+
+ (setq mark (gnus-article-mark number))
+ (push (gnus-data-make number mark (1+ (point)) header 0)
+ gnus-newsgroup-data)
+ (gnus-summary-insert-line
+ header 0 number
+ mark (memq number gnus-newsgroup-replied)
+ (memq number gnus-newsgroup-expirable)
+ (mail-header-subject header) nil
+ (cdr (assq number gnus-newsgroup-scored))
+ (memq number gnus-newsgroup-processable))))))
+
+(defun gnus-select-newsgroup (group &optional read-all)
+ "Select newsgroup GROUP.
+If READ-ALL is non-nil, all articles in the group are selected."
+ (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ ;;!!! Dirty hack; should be removed.
+ (gnus-summary-ignore-duplicates
+ (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
+ t
+ gnus-summary-ignore-duplicates))
+ (info (nth 2 entry))
+ articles fetched-articles cached)
+
+ (unless (gnus-check-server
+ (setq gnus-current-select-method
+ (gnus-find-method-for-group group)))
+ (error "Couldn't open server"))
+
+ (or (and entry (not (eq (car entry) t))) ; Either it's active...
+ (gnus-activate-group group) ; Or we can activate it...
+ (progn ; Or we bug out.
+ (when (equal major-mode 'gnus-summary-mode)
+ (kill-buffer (current-buffer)))
+ (error "Couldn't request group %s: %s"
+ group (gnus-status-message group))))
+
+ (unless (gnus-request-group group t)
+ (when (equal major-mode 'gnus-summary-mode)
+ (kill-buffer (current-buffer)))
+ (error "Couldn't request group %s: %s"
+ group (gnus-status-message group)))
+
+ (setq gnus-newsgroup-name group)
+ (setq gnus-newsgroup-unselected nil)
+ (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
+
+ ;; Adjust and set lists of article marks.
+ (when info
+ (gnus-adjust-marked-articles info))
+
+ ;; Kludge to avoid having cached articles nixed out in virtual groups.
+ (when (gnus-virtual-group-p group)
+ (setq cached gnus-newsgroup-cached))
+
+ (setq gnus-newsgroup-unreads
+ (gnus-set-difference
+ (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
+ gnus-newsgroup-dormant))
+
+ (setq gnus-newsgroup-processable nil)
+
+ (gnus-update-read-articles group gnus-newsgroup-unreads)
+ (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-group-update-group group))
+
+ (setq articles (gnus-articles-to-read group read-all))
+
+ (cond
+ ((null articles)
+ ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
+ 'quit)
+ ((eq articles 0) nil)
+ (t
+ ;; Init the dependencies hash table.
+ (setq gnus-newsgroup-dependencies
+ (gnus-make-hashtable (length articles)))
+ ;; Retrieve the headers and read them in.
+ (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
+ (setq gnus-newsgroup-headers
+ (if (eq 'nov
+ (setq gnus-headers-retrieved-by
+ (gnus-retrieve-headers
+ articles gnus-newsgroup-name
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and gnus-fetch-old-headers
+ (or (and
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))))))
+ (gnus-get-newsgroup-headers-xover
+ articles nil nil gnus-newsgroup-name t)
+ (gnus-get-newsgroup-headers)))
+ (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
+
+ ;; Kludge to avoid having cached articles nixed out in virtual groups.
+ (when cached
+ (setq gnus-newsgroup-cached cached))
+
+ ;; Suppress duplicates?
+ (when gnus-suppress-duplicates
+ (gnus-dup-suppress-articles))
+
+ ;; Set the initial limit.
+ (setq gnus-newsgroup-limit (copy-sequence articles))
+ ;; Remove canceled articles from the list of unread articles.
+ (setq gnus-newsgroup-unreads
+ (gnus-set-sorted-intersection
+ gnus-newsgroup-unreads
+ (setq fetched-articles
+ (mapcar (lambda (headers) (mail-header-number headers))
+ gnus-newsgroup-headers))))
+ ;; Removed marked articles that do not exist.
+ (gnus-update-missing-marks
+ (gnus-sorted-complement fetched-articles articles))
+ ;; Let the Gnus agent mark articles as read.
+ (when gnus-agent
+ (gnus-agent-get-undownloaded-list))
+ ;; We might want to build some more threads first.
+ (when (and gnus-fetch-old-headers
+ (eq gnus-headers-retrieved-by 'nov))
+ (if (eq gnus-fetch-old-headers 'invisible)
+ (gnus-build-all-threads)
+ (gnus-build-old-threads)))
+ ;; Check whether auto-expire is to be done in this group.
+ (setq gnus-newsgroup-auto-expire
+ (gnus-group-auto-expirable-p group))
+ ;; Set up the article buffer now, if necessary.
+ (unless gnus-single-article-buffer
+ (gnus-article-setup-buffer))
+ ;; First and last article in this newsgroup.
+ (when gnus-newsgroup-headers
+ (setq gnus-newsgroup-begin
+ (mail-header-number (car gnus-newsgroup-headers))
+ gnus-newsgroup-end
+ (mail-header-number
+ (gnus-last-element gnus-newsgroup-headers))))
+ ;; GROUP is successfully selected.
+ (or gnus-newsgroup-headers t)))))
+
+(defun gnus-articles-to-read (group &optional read-all)
+ ;; Find out what articles the user wants to read.
+ (let* ((articles
+ ;; Select all articles if `read-all' is non-nil, or if there
+ ;; are no unread articles.
+ (if (or read-all
+ (and (zerop (length gnus-newsgroup-marked))
+ (zerop (length gnus-newsgroup-unreads)))
+ (eq (gnus-group-find-parameter group 'display)
+ 'all))
+ (gnus-uncompress-range (gnus-active group))
+ (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
+ (copy-sequence gnus-newsgroup-unreads))
+ '<)))
+ (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
+ (scored (length scored-list))
+ (number (length articles))
+ (marked (+ (length gnus-newsgroup-marked)
+ (length gnus-newsgroup-dormant)))
+ (select
+ (cond
+ ((numberp read-all)
+ read-all)
+ (t
+ (condition-case ()
+ (cond
+ ((and (or (<= scored marked) (= scored number))
+ (numberp gnus-large-newsgroup)
+ (> number gnus-large-newsgroup))
+ (let ((input
+ (read-string
+ (format
+ "How many articles from %s (default %d): "
+ (gnus-limit-string gnus-newsgroup-name 35)
+ number))))
+ (if (string-match "^[ \t]*$" input) number input)))
+ ((and (> scored marked) (< scored number)
+ (> (- scored number) 20))
+ (let ((input
+ (read-string
+ (format "%s %s (%d scored, %d total): "
+ "How many articles from"
+ group scored number))))
+ (if (string-match "^[ \t]*$" input)
+ number input)))
+ (t number))
+ (quit nil))))))
+ (setq select (if (stringp select) (string-to-number select) select))
+ (if (or (null select) (zerop select))
+ select
+ (if (and (not (zerop scored)) (<= (abs select) scored))
+ (progn
+ (setq articles (sort scored-list '<))
+ (setq number (length articles)))
+ (setq articles (copy-sequence articles)))
+
+ (when (< (abs select) number)
+ (if (< select 0)
+ ;; Select the N oldest articles.
+ (setcdr (nthcdr (1- (abs select)) articles) nil)
+ ;; Select the N most recent articles.
+ (setq articles (nthcdr (- number select) articles))))
+ (setq gnus-newsgroup-unselected
+ (gnus-sorted-intersection
+ gnus-newsgroup-unreads
+ (gnus-sorted-complement gnus-newsgroup-unreads articles)))
+ articles)))
+
+(defun gnus-killed-articles (killed articles)
+ (let (out)
+ (while articles
+ (when (inline (gnus-member-of-range (car articles) killed))
+ (push (car articles) out))
+ (setq articles (cdr articles)))
+ out))
+
+(defun gnus-uncompress-marks (marks)
+ "Uncompress the mark ranges in MARKS."
+ (let ((uncompressed '(score bookmark))
+ out)
+ (while marks
+ (if (memq (caar marks) uncompressed)
+ (push (car marks) out)
+ (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
+ (setq marks (cdr marks)))
+ out))
+
+(defun gnus-adjust-marked-articles (info)
+ "Set all article lists and remove all marks that are no longer legal."
+ (let* ((marked-lists (gnus-info-marks info))
+ (active (gnus-active (gnus-info-group info)))
+ (min (car active))
+ (max (cdr active))
+ (types gnus-article-mark-lists)
+ (uncompressed '(score bookmark killed))
+ marks var articles article mark)
+
+ (while marked-lists
+ (setq marks (pop marked-lists))
+ (set (setq var (intern (format "gnus-newsgroup-%s"
+ (car (rassq (setq mark (car marks))
+ types)))))
+ (if (memq (car marks) uncompressed) (cdr marks)
+ (gnus-uncompress-range (cdr marks))))
+
+ (setq articles (symbol-value var))
+
+ ;; All articles have to be subsets of the active articles.
+ (cond
+ ;; Adjust "simple" lists.
+ ((memq mark '(tick dormant expire reply save))
+ (while articles
+ (when (or (< (setq article (pop articles)) min) (> article max))
+ (set var (delq article (symbol-value var))))))
+ ;; Adjust assocs.
+ ((memq mark uncompressed)
+ (when (not (listp (cdr (symbol-value var))))
+ (set var (list (symbol-value var))))
+ (when (not (listp (cdr articles)))
+ (setq articles (list articles)))
+ (while articles
+ (when (or (not (consp (setq article (pop articles))))
+ (< (car article) min)
+ (> (car article) max))
+ (set var (delq article (symbol-value var))))))))))
+
+(defun gnus-update-missing-marks (missing)
+ "Go through the list of MISSING articles and remove them mark lists."
+ (when missing
+ (let ((types gnus-article-mark-lists)
+ var m)
+ ;; Go through all types.
+ (while types
+ (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
+ (when (symbol-value var)
+ ;; This list has articles. So we delete all missing articles
+ ;; from it.
+ (setq m missing)
+ (while m
+ (set var (delq (pop m) (symbol-value var)))))))))
+
+(defun gnus-update-marks ()
+ "Enter the various lists of marked articles into the newsgroup info list."
+ (let ((types gnus-article-mark-lists)
+ (info (gnus-get-info gnus-newsgroup-name))
+ (uncompressed '(score bookmark killed))
+ type list newmarked symbol)
+ (when info
+ ;; Add all marks lists that are non-nil to the list of marks lists.
+ (while (setq type (pop types))
+ (when (setq list (symbol-value
+ (setq symbol
+ (intern (format "gnus-newsgroup-%s"
+ (car type))))))
+
+ ;; Get rid of the entries of the articles that have the
+ ;; default score.
+ (when (and (eq (cdr type) 'score)
+ gnus-save-score
+ list)
+ (let* ((arts list)
+ (prev (cons nil list))
+ (all prev))
+ (while arts
+ (if (or (not (consp (car arts)))
+ (= (cdar arts) gnus-summary-default-score))
+ (setcdr prev (cdr arts))
+ (setq prev arts))
+ (setq arts (cdr arts)))
+ (setq list (cdr all))))
+
+ (push (cons (cdr type)
+ (if (memq (cdr type) uncompressed) list
+ (gnus-compress-sequence
+ (set symbol (sort list '<)) t)))
+ newmarked)))
+
+ ;; Enter these new marks into the info of the group.
+ (if (nthcdr 3 info)
+ (setcar (nthcdr 3 info) newmarked)
+ ;; Add the marks lists to the end of the info.
+ (when newmarked
+ (setcdr (nthcdr 2 info) (list newmarked))))
+
+ ;; Cut off the end of the info if there's nothing else there.
+ (let ((i 5))
+ (while (and (> i 2)
+ (not (nth i info)))
+ (when (nthcdr (decf i) info)
+ (setcdr (nthcdr i info) nil)))))))
+
+(defun gnus-set-mode-line (where)
+ "This function sets the mode line of the article or summary buffers.
+If WHERE is `summary', the summary mode line format will be used."
+ ;; Is this mode line one we keep updated?
+ (when (memq where gnus-updated-mode-lines)
+ (let (mode-string)
+ (save-excursion
+ ;; We evaluate this in the summary buffer since these
+ ;; variables are buffer-local to that buffer.
+ (set-buffer gnus-summary-buffer)
+ ;; We bind all these variables that are used in the `eval' form
+ ;; below.
+ (let* ((mformat (symbol-value
+ (intern
+ (format "gnus-%s-mode-line-format-spec" where))))
+ (gnus-tmp-group-name gnus-newsgroup-name)
+ (gnus-tmp-article-number (or gnus-current-article 0))
+ (gnus-tmp-unread gnus-newsgroup-unreads)
+ (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
+ (gnus-tmp-unselected (length gnus-newsgroup-unselected))
+ (gnus-tmp-unread-and-unselected
+ (cond ((and (zerop gnus-tmp-unread-and-unticked)
+ (zerop gnus-tmp-unselected))
+ "")
+ ((zerop gnus-tmp-unselected)
+ (format "{%d more}" gnus-tmp-unread-and-unticked))
+ (t (format "{%d(+%d) more}"
+ gnus-tmp-unread-and-unticked
+ gnus-tmp-unselected))))
+ (gnus-tmp-subject
+ (if (and gnus-current-headers
+ (vectorp gnus-current-headers))
+ (gnus-mode-string-quote
+ (mail-header-subject gnus-current-headers))
+ ""))
+ bufname-length max-len
+ gnus-tmp-header);; passed as argument to any user-format-funcs
+ (setq mode-string (eval mformat))
+ (setq bufname-length (if (string-match "%b" mode-string)
+ (- (length
+ (buffer-name
+ (if (eq where 'summary)
+ nil
+ (get-buffer gnus-article-buffer))))
+ 2)
+ 0))
+ (setq max-len (max 4 (if gnus-mode-non-string-length
+ (- (window-width)
+ gnus-mode-non-string-length
+ bufname-length)
+ (length mode-string))))
+ ;; We might have to chop a bit of the string off...
+ (when (> (length mode-string) max-len)
+ (setq mode-string
+ (concat (gnus-truncate-string mode-string (- max-len 3))
+ "...")))
+ ;; Pad the mode string a bit.
+ (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
+ ;; Update the mode line.
+ (setq mode-line-buffer-identification
+ (gnus-mode-line-buffer-identification (list mode-string)))
+ (set-buffer-modified-p t))))
+
+(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
+ "Go through the HEADERS list and add all Xrefs to a hash table.
+The resulting hash table is returned, or nil if no Xrefs were found."
+ (let* ((virtual (gnus-virtual-group-p from-newsgroup))
+ (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
+ (xref-hashtb (gnus-make-hashtable))
+ start group entry number xrefs header)
+ (while headers
+ (setq header (pop headers))
+ (when (and (setq xrefs (mail-header-xref header))
+ (not (memq (setq number (mail-header-number header))
+ unreads)))
+ (setq start 0)
+ (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
+ (setq start (match-end 0))
+ (setq group (if prefix
+ (concat prefix (substring xrefs (match-beginning 1)
+ (match-end 1)))
+ (substring xrefs (match-beginning 1) (match-end 1))))
+ (setq number
+ (string-to-int (substring xrefs (match-beginning 2)
+ (match-end 2))))
+ (if (setq entry (gnus-gethash group xref-hashtb))
+ (setcdr entry (cons number (cdr entry)))
+ (gnus-sethash group (cons number nil) xref-hashtb)))))
+ (and start xref-hashtb)))
+
+(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
+ "Look through all the headers and mark the Xrefs as read."
+ (let ((virtual (gnus-virtual-group-p from-newsgroup))
+ name entry info xref-hashtb idlist method nth4)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (when (setq xref-hashtb
+ (gnus-create-xref-hashtb from-newsgroup headers unreads))
+ (mapatoms
+ (lambda (group)
+ (unless (string= from-newsgroup (setq name (symbol-name group)))
+ (setq idlist (symbol-value group))
+ ;; Dead groups are not updated.
+ (and (prog1
+ (setq entry (gnus-gethash name gnus-newsrc-hashtb)
+ info (nth 2 entry))
+ (when (stringp (setq nth4 (gnus-info-method info)))
+ (setq nth4 (gnus-server-to-method nth4))))
+ ;; Only do the xrefs if the group has the same
+ ;; select method as the group we have just read.
+ (or (gnus-methods-equal-p
+ nth4 (gnus-find-method-for-group from-newsgroup))
+ virtual
+ (equal nth4 (setq method (gnus-find-method-for-group
+ from-newsgroup)))
+ (and (equal (car nth4) (car method))
+ (equal (nth 1 nth4) (nth 1 method))))
+ gnus-use-cross-reference
+ (or (not (eq gnus-use-cross-reference t))
+ virtual
+ ;; Only do cross-references on subscribed
+ ;; groups, if that is what is wanted.
+ (<= (gnus-info-level info) gnus-level-subscribed))
+ (gnus-group-make-articles-read name idlist))))
+ xref-hashtb)))))
+
+(defun gnus-compute-read-articles (group articles)
+ (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ (info (nth 2 entry))
+ (active (gnus-active group))
+ ninfo)
+ (when entry
+ ;; First peel off all illegal article numbers.
+ (when active
+ (let ((ids articles)
+ id first)
+ (while (setq id (pop ids))
+ (when (and first (> id (cdr active)))
+ ;; We'll end up in this situation in one particular
+ ;; obscure situation. If you re-scan a group and get
+ ;; a new article that is cross-posted to a different
+ ;; group that has not been re-scanned, you might get
+ ;; crossposted article that has a higher number than
+ ;; Gnus believes possible. So we re-activate this
+ ;; group as well. This might mean doing the
+ ;; crossposting thingy will *increase* the number
+ ;; of articles in some groups. Tsk, tsk.
+ (setq active (or (gnus-activate-group group) active)))
+ (when (or (> id (cdr active))
+ (< id (car active)))
+ (setq articles (delq id articles))))))
+ ;; If the read list is nil, we init it.
+ (if (and active
+ (null (gnus-info-read info))
+ (> (car active) 1))
+ (setq ninfo (cons 1 (1- (car active))))
+ (setq ninfo (gnus-info-read info)))
+ ;; Then we add the read articles to the range.
+ (gnus-add-to-range
+ ninfo (setq articles (sort articles '<))))))
+
+(defun gnus-group-make-articles-read (group articles)
+ "Update the info of GROUP to say that ARTICLES are read."
+ (let* ((num 0)
+ (entry (gnus-gethash group gnus-newsrc-hashtb))
+ (info (nth 2 entry))
+ (active (gnus-active group))
+ range)
+ (when entry
+ (setq range (gnus-compute-read-articles group articles))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
+ ;; Add the read articles to the range.
+ (gnus-info-set-read info range)
+ ;; Then we have to re-compute how many unread
+ ;; articles there are in this group.
+ (when active
+ (cond
+ ((not range)
+ (setq num (- (1+ (cdr active)) (car active))))
+ ((not (listp (cdr range)))
+ (setq num (- (cdr active) (- (1+ (cdr range))
+ (car range)))))
+ (t
+ (while range
+ (if (numberp (car range))
+ (setq num (1+ num))
+ (setq num (+ num (- (1+ (cdar range)) (caar range)))))
+ (setq range (cdr range)))
+ (setq num (- (cdr active) num))))
+ ;; Update the number of unread articles.
+ (setcar entry num)
+ ;; Update the group buffer.
+ (gnus-group-update-group group t)))))
+
+(defun gnus-methods-equal-p (m1 m2)
+ (let ((m1 (or m1 gnus-select-method))
+ (m2 (or m2 gnus-select-method)))
+ (or (equal m1 m2)
+ (and (eq (car m1) (car m2))
+ (or (not (memq 'address (assoc (symbol-name (car m1))
+ gnus-valid-select-methods)))
+ (equal (nth 1 m1) (nth 1 m2)))))))
+
+(defvar gnus-newsgroup-none-id 0)
+
+(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
+ (let ((cur nntp-server-buffer)
+ (dependencies
+ (or dependencies
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-dependencies)))
+ headers id id-dep ref-dep end ref)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ ;; Translate all TAB characters into SPACE characters.
+ (subst-char-in-region (point-min) (point-max) ?\t ? t)
+ (run-hooks 'gnus-parse-headers-hook)
+ (let ((case-fold-search t)
+ in-reply-to header p lines)
+ (goto-char (point-min))
+ ;; Search to the beginning of the next header. Error messages
+ ;; do not begin with 2 or 3.
+ (while (re-search-forward "^[23][0-9]+ " nil t)
+ (setq id nil
+ ref nil)
+ ;; This implementation of this function, with nine
+ ;; search-forwards instead of the one re-search-forward and
+ ;; a case (which basically was the old function) is actually
+ ;; about twice as fast, even though it looks messier. You
+ ;; can't have everything, I guess. Speed and elegance
+ ;; doesn't always go hand in hand.
+ (setq
+ header
+ (vector
+ ;; Number.
+ (prog1
+ (read cur)
+ (end-of-line)
+ (setq p (point))
+ (narrow-to-region (point)
+ (or (and (search-forward "\n.\n" nil t)
+ (- (point) 2))
+ (point))))
+ ;; Subject.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nsubject: " nil t)
+ ;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ (funcall
+ gnus-unstructured-field-decoder (nnheader-header-value))
+ "(none)"))
+ ;; From.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nfrom: " nil t)
+ ;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ (funcall
+ gnus-structured-field-decoder (nnheader-header-value))
+ "(nobody)"))
+ ;; Date.
+ (progn
+ (goto-char p)
+ (if (search-forward "\ndate: " nil t)
+ (nnheader-header-value) ""))
+ ;; Message-ID.
+ (progn
+ (goto-char p)
+ (setq id (if (search-forward "\nmessage-id:" nil t)
+ (buffer-substring
+ (1- (or (search-forward "<" nil t) (point)))
+ (or (search-forward ">" nil t) (point)))
+ ;; If there was no message-id, we just fake one
+ ;; to make subsequent routines simpler.
+ (nnheader-generate-fake-message-id))))
+ ;; References.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nreferences: " nil t)
+ (progn
+ (setq end (point))
+ (prog1
+ (nnheader-header-value)
+ (setq ref
+ (buffer-substring
+ (progn
+ (end-of-line)
+ (search-backward ">" end t)
+ (1+ (point)))
+ (progn
+ (search-backward "<" end t)
+ (point))))))
+ ;; Get the references from the in-reply-to header if there
+ ;; were no references and the in-reply-to header looks
+ ;; promising.
+ (if (and (search-forward "\nin-reply-to: " nil t)
+ (setq in-reply-to (nnheader-header-value))
+ (string-match "<[^>]+>" in-reply-to))
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (setq ref nil))))
+ ;; Chars.
+ 0
+ ;; Lines.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nlines: " nil t)
+ (if (numberp (setq lines (ignore-errors (read cur))))
+ lines 0)
+ 0))
+ ;; Xref.
+ (progn
+ (goto-char p)
+ (and (search-forward "\nxref: " nil t)
+ (nnheader-header-value)))))
+ (when (equal id ref)
+ (setq ref nil))
+
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function header)
+ (setq id (mail-header-id header)
+ ref (gnus-parent-id (mail-header-references header))))
+
+ ;; We do the threading while we read the headers. The
+ ;; message-id and the last reference are both entered into
+ ;; the same hash table. Some tippy-toeing around has to be
+ ;; done in case an article has arrived before the article
+ ;; which it refers to.
+ (if (boundp (setq id-dep (intern id dependencies)))
+ (if (and (car (symbol-value id-dep))
+ (not force-new))
+ ;; An article with this Message-ID has already been seen.
+ (if gnus-summary-ignore-duplicates
+ ;; We ignore this one, except we add
+ ;; any additional Xrefs (in case the two articles
+ ;; came from different servers).
+ (progn
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref
+ (car (symbol-value id-dep)))
+ "")
+ (or (mail-header-xref header) "")))
+ (setq header nil))
+ ;; We rename the Message-ID.
+ (set
+ (setq id-dep (intern (setq id (nnmail-message-id))
+ dependencies))
+ (list header))
+ (mail-header-set-id header id))
+ (setcar (symbol-value id-dep) header))
+ (set id-dep (list header)))
+ (when header
+ (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (symbol-value id-dep))))
+ (set ref-dep (list nil (symbol-value id-dep))))
+ (push header headers))
+ (goto-char (point-max))
+ (widen))
+ (nreverse headers)))))
+
+;; The following macros and functions were written by Felix Lee
+;; <flee@cse.psu.edu>.
+
+(defmacro gnus-nov-read-integer ()
+ '(prog1
+ (if (= (following-char) ?\t)
+ 0
+ (let ((num (ignore-errors (read buffer))))
+ (if (numberp num) num 0)))
+ (unless (eobp)
+ (forward-char 1))))
+
+(defmacro gnus-nov-skip-field ()
+ '(search-forward "\t" eol 'move))
+
+(defmacro gnus-nov-field ()
+ '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
+
+;; (defvar gnus-nov-none-counter 0)
+
+;; This function has to be called with point after the article number
+;; on the beginning of the line.
+(defun gnus-nov-parse-line (number dependencies &optional force-new)
+ (let ((eol (gnus-point-at-eol))
+ (buffer (current-buffer))
+ header ref id id-dep ref-dep)
+
+ ;; overview: [num subject from date id refs chars lines misc]
+ (unwind-protect
+ (progn
+ (narrow-to-region (point) eol)
+ (unless (eobp)
+ (forward-char))
+
+ (setq header
+ (vector
+ number ; number
+ (funcall
+ gnus-unstructured-field-decoder (gnus-nov-field)) ; subject
+ (funcall
+ gnus-structured-field-decoder (gnus-nov-field)) ; from
+ (gnus-nov-field) ; date
+ (setq id (or (gnus-nov-field)
+ (nnheader-generate-fake-message-id))) ; id
+ (progn
+ (let ((beg (point)))
+ (search-forward "\t" eol)
+ (if (search-backward ">" beg t)
+ (setq ref
+ (buffer-substring
+ (1+ (point))
+ (search-backward "<" beg t)))
+ (setq ref nil))
+ (goto-char beg))
+ (gnus-nov-field)) ; refs
+ (gnus-nov-read-integer) ; chars
+ (gnus-nov-read-integer) ; lines
+ (if (= (following-char) ?\n)
+ nil
+ (gnus-nov-field))))) ; misc
+
+ (widen))
+
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function header)
+ (setq id (mail-header-id header)
+ ref (gnus-parent-id (mail-header-references header))))
+
+ ;; We build the thread tree.
+ (when (equal id ref)
+ ;; This article refers back to itself. Naughty, naughty.
+ (setq ref nil))
+ (if (boundp (setq id-dep (intern id dependencies)))
+ (if (and (car (symbol-value id-dep))
+ (not force-new))
+ ;; An article with this Message-ID has already been seen.
+ (if gnus-summary-ignore-duplicates
+ ;; We ignore this one, except we add any additional
+ ;; Xrefs (in case the two articles came from different
+ ;; servers.
+ (progn
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref
+ (car (symbol-value id-dep)))
+ "")
+ (or (mail-header-xref header) "")))
+ (setq header nil))
+ ;; We rename the Message-ID.
+ (set
+ (setq id-dep (intern (setq id (nnmail-message-id))
+ dependencies))
+ (list header))
+ (mail-header-set-id header id))
+ (setcar (symbol-value id-dep) header))
+ (set id-dep (list header)))
+ (when header
+ (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (symbol-value id-dep))))
+ (set ref-dep (list nil (symbol-value id-dep)))))
+ header))
+
+;; Goes through the xover lines and returns a list of vectors
+(defun gnus-get-newsgroup-headers-xover (sequence &optional
+ force-new dependencies
+ group also-fetch-heads)
+ "Parse the news overview data in the server buffer, and return a
+list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
+ ;; Get the Xref when the users reads the articles since most/some
+ ;; NNTP servers do not include Xrefs when using XOVER.
+ (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
+ (let ((cur nntp-server-buffer)
+ (dependencies (or dependencies gnus-newsgroup-dependencies))
+ number headers header)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ ;; Allow the user to mangle the headers before parsing them.
+ (run-hooks 'gnus-parse-headers-hook)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (condition-case ()
+ (while (and sequence (not (eobp)))
+ (setq number (read cur))
+ (while (and sequence
+ (< (car sequence) number))
+ (setq sequence (cdr sequence)))
+ (and sequence
+ (eq number (car sequence))
+ (progn
+ (setq sequence (cdr sequence))
+ (setq header (inline
+ (gnus-nov-parse-line
+ number dependencies force-new))))
+ (push header headers))
+ (forward-line 1))
+ (error
+ (gnus-error 4 "Strange nov line (%d)"
+ (count-lines (point-min) (point)))))
+ (forward-line 1))
+ ;; A common bug in inn is that if you have posted an article and
+ ;; then retrieves the active file, it will answer correctly --
+ ;; the new article is included. However, a NOV entry for the
+ ;; article may not have been generated yet, so this may fail.
+ ;; We work around this problem by retrieving the last few
+ ;; headers using HEAD.
+ (if (or (not also-fetch-heads)
+ (not sequence))
+ ;; We (probably) got all the headers.
+ (nreverse headers)
+ (let ((gnus-nov-is-evil t))
+ (nconc
+ (nreverse headers)
+ (when (gnus-retrieve-headers sequence group)
+ (gnus-get-newsgroup-headers))))))))
+
+(defun gnus-article-get-xrefs ()
+ "Fill in the Xref value in `gnus-current-headers', if necessary.
+This is meant to be called in `gnus-article-internal-prepare-hook'."
+ (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-current-headers)))
+ (or (not gnus-use-cross-reference)
+ (not headers)
+ (and (mail-header-xref headers)
+ (not (string= (mail-header-xref headers) "")))
+ (let ((case-fold-search t)
+ xref)
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (goto-char (point-min))
+ (when (or (and (eq (downcase (following-char)) ?x)
+ (looking-at "Xref:"))
+ (search-forward "\nXref:" nil t))
+ (goto-char (1+ (match-end 0)))
+ (setq xref (buffer-substring (point)
+ (progn (end-of-line) (point))))
+ (mail-header-set-xref headers xref)))))))
+
+(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
+ "Find article ID and insert the summary line for that article."
+ (let ((header (if (and old-header use-old-header)
+ old-header (gnus-read-header id)))
+ (number (and (numberp id) id))
+ pos d)
+ (when header
+ ;; Rebuild the thread that this article is part of and go to the
+ ;; article we have fetched.
+ (when (and (not gnus-show-threads)
+ old-header)
+ (when (setq d (gnus-data-find (mail-header-number old-header)))
+ (goto-char (gnus-data-pos d))
+ (gnus-data-remove
+ number
+ (- (gnus-point-at-bol)
+ (prog1
+ (1+ (gnus-point-at-eol))
+ (gnus-delete-line))))))
+ (when old-header
+ (mail-header-set-number header (mail-header-number old-header)))
+ (setq gnus-newsgroup-sparse
+ (delq (setq number (mail-header-number header))
+ gnus-newsgroup-sparse))
+ (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
+ (gnus-rebuild-thread (mail-header-id header))
+ (gnus-summary-goto-subject number nil t))
+ (when (and (numberp number)
+ (> number 0))
+ ;; We have to update the boundaries even if we can't fetch the
+ ;; article if ID is a number -- so that the next `P' or `N'
+ ;; command will fetch the previous (or next) article even
+ ;; if the one we tried to fetch this time has been canceled.
+ (when (> number gnus-newsgroup-end)
+ (setq gnus-newsgroup-end number))
+ (when (< number gnus-newsgroup-begin)
+ (setq gnus-newsgroup-begin number))
+ (setq gnus-newsgroup-unselected
+ (delq number gnus-newsgroup-unselected)))
+ ;; Report back a success?
+ (and header (mail-header-number header))))
+
+;;; Process/prefix in the summary buffer
+
+(defun gnus-summary-work-articles (n)
+ "Return a list of articles to be worked upon. The prefix argument,
+the list of process marked articles, and the current article will be
+taken into consideration."
+ (cond
+ (n
+ ;; A numerical prefix has been given.
+ (setq n (prefix-numeric-value n))
+ (let ((backward (< n 0))
+ (n (abs (prefix-numeric-value n)))
+ articles article)
+ (save-excursion
+ (while
+ (and (> n 0)
+ (push (setq article (gnus-summary-article-number))
+ articles)
+ (if backward
+ (gnus-summary-find-prev nil article)
+ (gnus-summary-find-next nil article)))
+ (decf n)))
+ (nreverse articles)))
+ ((gnus-region-active-p)
+ ;; Work on the region between point and mark.
+ (let ((max (max (point) (mark)))
+ articles article)
+ (save-excursion
+ (goto-char (min (point) (mark)))
+ (while
+ (and
+ (push (setq article (gnus-summary-article-number)) articles)
+ (gnus-summary-find-next nil article)
+ (< (point) max)))
+ (nreverse articles))))
+ (gnus-newsgroup-processable
+ ;; There are process-marked articles present.
+ ;; Save current state.
+ (gnus-summary-save-process-mark)
+ ;; Return the list.
+ (reverse gnus-newsgroup-processable))
+ (t
+ ;; Just return the current article.
+ (list (gnus-summary-article-number)))))
+
+(defun gnus-summary-save-process-mark ()
+ "Push the current set of process marked articles on the stack."
+ (interactive)
+ (push (copy-sequence gnus-newsgroup-processable)
+ gnus-newsgroup-process-stack))
+
+(defun gnus-summary-kill-process-mark ()
+ "Push the current set of process marked articles on the stack and unmark."
+ (interactive)
+ (gnus-summary-save-process-mark)
+ (gnus-summary-unmark-all-processable))
+
+(defun gnus-summary-yank-process-mark ()
+ "Pop the last process mark state off the stack and restore it."
+ (interactive)
+ (unless gnus-newsgroup-process-stack
+ (error "Empty mark stack"))
+ (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack)))
+
+(defun gnus-summary-process-mark-set (set)
+ "Make SET into the current process marked articles."
+ (gnus-summary-unmark-all-processable)
+ (while set
+ (gnus-summary-set-process-mark (pop set))))
+
+;;; Searching and stuff
+
+(defun gnus-summary-search-group (&optional backward use-level)
+ "Search for next unread newsgroup.
+If optional argument BACKWARD is non-nil, search backward instead."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (when (gnus-group-search-forward
+ backward nil (if use-level (gnus-group-group-level) nil))
+ (gnus-group-group-name))))
+
+(defun gnus-summary-best-group (&optional exclude-group)
+ "Find the name of the best unread group.
+If EXCLUDE-GROUP, do not go to this group."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (save-excursion
+ (gnus-group-best-unread-group exclude-group))))
+
+(defun gnus-summary-find-next (&optional unread article backward)
+ (if backward (gnus-summary-find-prev)
+ (let* ((dummy (gnus-summary-article-intangible-p))
+ (article (or article (gnus-summary-article-number)))
+ (arts (gnus-data-find-list article))
+ result)
+ (when (and (not dummy)
+ (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts)))))
+ (setq arts (cdr arts)))
+ (when (setq result
+ (if unread
+ (progn
+ (while arts
+ (when (gnus-data-unread-p (car arts))
+ (setq result (car arts)
+ arts nil))
+ (setq arts (cdr arts)))
+ result)
+ (car arts)))
+ (goto-char (gnus-data-pos result))
+ (gnus-data-number result)))))
+
+(defun gnus-summary-find-prev (&optional unread article)
+ (let* ((eobp (eobp))
+ (article (or article (gnus-summary-article-number)))
+ (arts (gnus-data-find-list article (gnus-data-list 'rev)))
+ result)
+ (when (and (not eobp)
+ (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts)))))
+ (setq arts (cdr arts)))
+ (when (setq result
+ (if unread
+ (progn
+ (while arts
+ (when (gnus-data-unread-p (car arts))
+ (setq result (car arts)
+ arts nil))
+ (setq arts (cdr arts)))
+ result)
+ (car arts)))
+ (goto-char (gnus-data-pos result))
+ (gnus-data-number result))))
+
+(defun gnus-summary-find-subject (subject &optional unread backward article)
+ (let* ((simp-subject (gnus-simplify-subject-fully subject))
+ (article (or article (gnus-summary-article-number)))
+ (articles (gnus-data-list backward))
+ (arts (gnus-data-find-list article articles))
+ result)
+ (when (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts))))
+ (setq arts (cdr arts)))
+ (while arts
+ (and (or (not unread)
+ (gnus-data-unread-p (car arts)))
+ (vectorp (gnus-data-header (car arts)))
+ (gnus-subject-equal
+ simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
+ (setq result (car arts)
+ arts nil))
+ (setq arts (cdr arts)))
+ (and result
+ (goto-char (gnus-data-pos result))
+ (gnus-data-number result))))
+
+(defun gnus-summary-search-forward (&optional unread subject backward)
+ "Search forward for an article.
+If UNREAD, look for unread articles. If SUBJECT, look for
+articles with that subject. If BACKWARD, search backward instead."
+ (cond (subject (gnus-summary-find-subject subject unread backward))
+ (backward (gnus-summary-find-prev unread))
+ (t (gnus-summary-find-next unread))))
+
+(defun gnus-recenter (&optional n)
+ "Center point in window and redisplay frame.
+Also do horizontal recentering."
+ (interactive "P")
+ (when (and gnus-auto-center-summary
+ (not (eq gnus-auto-center-summary 'vertical)))
+ (gnus-horizontal-recenter))
+ (recenter n))
+
+(defun gnus-summary-recenter ()
+ "Center point in the summary window.
+If `gnus-auto-center-summary' is nil, or the article buffer isn't
+displayed, no centering will be performed."
+ ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
+ ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
+ (let* ((top (cond ((< (window-height) 4) 0)
+ ((< (window-height) 7) 1)
+ (t 2)))
+ (height (1- (window-height)))
+ (bottom (save-excursion (goto-char (point-max))
+ (forward-line (- height))
+ (point)))
+ (window (get-buffer-window (current-buffer))))
+ ;; The user has to want it.
+ (when gnus-auto-center-summary
+ (when (get-buffer-window gnus-article-buffer)
+ ;; Only do recentering when the article buffer is displayed,
+ ;; Set the window start to either `bottom', which is the biggest
+ ;; possible valid number, or the second line from the top,
+ ;; whichever is the least.
+ (set-window-start
+ window (min bottom (save-excursion
+ (forward-line (- top)) (point)))))
+ ;; Do horizontal recentering while we're at it.
+ (when (and (get-buffer-window (current-buffer) t)
+ (not (eq gnus-auto-center-summary 'vertical)))
+ (let ((selected (selected-window)))
+ (select-window (get-buffer-window (current-buffer) t))
+ (gnus-summary-position-point)
+ (gnus-horizontal-recenter)
+ (select-window selected))))))
+
+(defun gnus-summary-jump-to-group (newsgroup)
+ "Move point to NEWSGROUP in group mode buffer."
+ ;; Keep update point of group mode buffer if visible.
+ (if (eq (current-buffer) (get-buffer gnus-group-buffer))
+ (save-window-excursion
+ ;; Take care of tree window mode.
+ (when (get-buffer-window gnus-group-buffer)
+ (pop-to-buffer gnus-group-buffer))
+ (gnus-group-jump-to-group newsgroup))
+ (save-excursion
+ ;; Take care of tree window mode.
+ (if (get-buffer-window gnus-group-buffer)
+ (pop-to-buffer gnus-group-buffer)
+ (set-buffer gnus-group-buffer))
+ (gnus-group-jump-to-group newsgroup))))
+
+;; This function returns a list of article numbers based on the
+;; difference between the ranges of read articles in this group and
+;; the range of active articles.
+(defun gnus-list-of-unread-articles (group)
+ (let* ((read (gnus-info-read (gnus-get-info group)))
+ (active (or (gnus-active group) (gnus-activate-group group)))
+ (last (cdr active))
+ first nlast unread)
+ ;; If none are read, then all are unread.
+ (if (not read)
+ (setq first (car active))
+ ;; If the range of read articles is a single range, then the
+ ;; first unread article is the article after the last read
+ ;; article. Sounds logical, doesn't it?
+ (if (not (listp (cdr read)))
+ (setq first (1+ (cdr read)))
+ ;; `read' is a list of ranges.
+ (when (/= (setq nlast (or (and (numberp (car read)) (car read))
+ (caar read)))
+ 1)
+ (setq first 1))
+ (while read
+ (when first
+ (while (< first nlast)
+ (push first unread)
+ (setq first (1+ first))))
+ (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
+ (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
+ (setq read (cdr read)))))
+ ;; And add the last unread articles.
+ (while (<= first last)
+ (push first unread)
+ (setq first (1+ first)))
+ ;; Return the list of unread articles.
+ (delq 0 (nreverse unread))))
+
+(defun gnus-list-of-read-articles (group)
+ "Return a list of unread, unticked and non-dormant articles."
+ (let* ((info (gnus-get-info group))
+ (marked (gnus-info-marks info))
+ (active (gnus-active group)))
+ (and info active
+ (gnus-set-difference
+ (gnus-sorted-complement
+ (gnus-uncompress-range active)
+ (gnus-list-of-unread-articles group))
+ (append
+ (gnus-uncompress-range (cdr (assq 'dormant marked)))
+ (gnus-uncompress-range (cdr (assq 'tick marked))))))))
+
+;; Various summary commands
+
+(defun gnus-summary-universal-argument (arg)
+ "Perform any operation on all articles that are process/prefixed."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((articles (gnus-summary-work-articles arg))
+ func article)
+ (if (eq
+ (setq
+ func
+ (key-binding
+ (read-key-sequence
+ (substitute-command-keys
+ "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
+ ))))
+ 'undefined)
+ (gnus-error 1 "Undefined key")
+ (save-excursion
+ (while articles
+ (gnus-summary-goto-subject (setq article (pop articles)))
+ (let (gnus-newsgroup-processable)
+ (command-execute func))
+ (gnus-summary-remove-process-mark article)))))
+ (gnus-summary-position-point))
+
+(defun gnus-summary-toggle-truncation (&optional arg)
+ "Toggle truncation of summary lines.
+With arg, turn line truncation on iff arg is positive."
+ (interactive "P")
+ (setq truncate-lines
+ (if (null arg) (not truncate-lines)
+ (> (prefix-numeric-value arg) 0)))
+ (redraw-display))
+
+(defun gnus-summary-reselect-current-group (&optional all rescan)
+ "Exit and then reselect the current newsgroup.
+The prefix argument ALL means to select all articles."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (when (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (error "Ephemeral groups can't be reselected"))
+ (let ((current-subject (gnus-summary-article-number))
+ (group gnus-newsgroup-name))
+ (setq gnus-newsgroup-begin nil)
+ (gnus-summary-exit)
+ ;; We have to adjust the point of group mode buffer because
+ ;; point was moved to the next unread newsgroup by exiting.
+ (gnus-summary-jump-to-group group)
+ (when rescan
+ (save-excursion
+ (gnus-group-get-new-news-this-group 1)))
+ (gnus-group-read-group all t)
+ (gnus-summary-goto-subject current-subject nil t)))
+
+(defun gnus-summary-rescan-group (&optional all)
+ "Exit the newsgroup, ask for new articles, and select the newsgroup."
+ (interactive "P")
+ (gnus-summary-reselect-current-group all t))
+
+(defun gnus-summary-update-info (&optional non-destructive)
+ (save-excursion
+ (let ((group gnus-newsgroup-name))
+ (when gnus-newsgroup-kill-headers
+ (setq gnus-newsgroup-killed
+ (gnus-compress-sequence
+ (nconc
+ (gnus-set-sorted-intersection
+ (gnus-uncompress-range gnus-newsgroup-killed)
+ (setq gnus-newsgroup-unselected
+ (sort gnus-newsgroup-unselected '<)))
+ (setq gnus-newsgroup-unreads
+ (sort gnus-newsgroup-unreads '<)))
+ t)))
+ (unless (listp (cdr gnus-newsgroup-killed))
+ (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
+ (let ((headers gnus-newsgroup-headers))
+ (when (and (not gnus-save-score)
+ (not non-destructive))
+ (setq gnus-newsgroup-scored nil))
+ ;; Set the new ranges of read articles.
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-force-boundary))
+ (gnus-update-read-articles
+ group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
+ ;; Set the current article marks.
+ (gnus-update-marks)
+ ;; Do the cross-ref thing.
+ (when gnus-use-cross-reference
+ (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
+ ;; Do adaptive scoring, and possibly save score files.
+ (when gnus-newsgroup-adaptive
+ (gnus-score-adaptive))
+ (when gnus-use-scoring
+ (gnus-score-save))
+ ;; Do not switch windows but change the buffer to work.
+ (set-buffer gnus-group-buffer)
+ (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-group-update-group group))))))
+
+(defun gnus-summary-save-newsrc (&optional force)
+ "Save the current number of read/marked articles in the dribble buffer.
+The dribble buffer will then be saved.
+If FORCE (the prefix), also save the .newsrc file(s)."
+ (interactive "P")
+ (gnus-summary-update-info t)
+ (if force
+ (gnus-save-newsrc-file)
+ (gnus-dribble-save)))
+
+(defun gnus-summary-exit (&optional temporary)
+ "Exit reading current newsgroup, and then return to group selection mode.
+gnus-exit-group-hook is called with no arguments if that value is non-nil."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-kill-save-kill-buffer)
+ (let* ((group gnus-newsgroup-name)
+ (quit-config (gnus-group-quit-config gnus-newsgroup-name))
+ (mode major-mode)
+ (group-point nil)
+ (buf (current-buffer)))
+ (run-hooks 'gnus-summary-prepare-exit-hook)
+ ;; If we have several article buffers, we kill them at exit.
+ (unless gnus-single-article-buffer
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
+ (when gnus-use-cache
+ (gnus-cache-possibly-remove-articles)
+ (gnus-cache-save-buffers))
+ (gnus-async-prefetch-remove-group group)
+ (when gnus-suppress-duplicates
+ (gnus-dup-enter-articles))
+ (when gnus-use-trees
+ (gnus-tree-close group))
+ ;; Make all changes in this group permanent.
+ (unless quit-config
+ (run-hooks 'gnus-exit-group-hook)
+ (gnus-summary-update-info))
+ (gnus-close-group group)
+ ;; Make sure where we were, and go to next newsgroup.
+ (set-buffer gnus-group-buffer)
+ (unless quit-config
+ (gnus-group-jump-to-group group))
+ (run-hooks 'gnus-summary-exit-hook)
+ (unless quit-config
+ (gnus-group-next-unread-group 1))
+ (setq group-point (point))
+ (if temporary
+ nil ;Nothing to do.
+ ;; If we have several article buffers, we kill them at exit.
+ (unless gnus-single-article-buffer
+ (gnus-kill-buffer gnus-article-buffer)
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
+ (set-buffer buf)
+ (if (not gnus-kill-summary-on-exit)
+ (gnus-deaden-summary)
+ ;; We set all buffer-local variables to nil. It is unclear why
+ ;; this is needed, but if we don't, buffer-local variables are
+ ;; not garbage-collected, it seems. This would the lead to en
+ ;; ever-growing Emacs.
+ (gnus-summary-clear-local-variables)
+ (when (get-buffer gnus-article-buffer)
+ (bury-buffer gnus-article-buffer))
+ ;; We clear the global counterparts of the buffer-local
+ ;; variables as well, just to be on the safe side.
+ (set-buffer gnus-group-buffer)
+ (gnus-summary-clear-local-variables)
+ ;; Return to group mode buffer.
+ (when (eq mode 'gnus-summary-mode)
+ (gnus-kill-buffer buf)))
+ (setq gnus-current-select-method gnus-select-method)
+ (pop-to-buffer gnus-group-buffer)
+ ;; Clear the current group name.
+ (if (not quit-config)
+ (progn
+ (goto-char group-point)
+ (gnus-configure-windows 'group 'force))
+ (gnus-handle-ephemeral-exit quit-config))
+ (unless quit-config
+ (setq gnus-newsgroup-name nil)))))
+
+(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
+(defun gnus-summary-exit-no-update (&optional no-questions)
+ "Quit reading current newsgroup without updating read article info."
+ (interactive)
+ (gnus-set-global-variables)
+ (let* ((group gnus-newsgroup-name)
+ (quit-config (gnus-group-quit-config group)))
+ (when (or no-questions
+ gnus-expert-user
+ (gnus-y-or-n-p "Discard changes to this group and exit? "))
+ ;; If we have several article buffers, we kill them at exit.
+ (unless gnus-single-article-buffer
+ (gnus-kill-buffer gnus-article-buffer)
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
+ (if (not gnus-kill-summary-on-exit)
+ (gnus-deaden-summary)
+ (gnus-close-group group)
+ (gnus-summary-clear-local-variables)
+ (set-buffer gnus-group-buffer)
+ (gnus-summary-clear-local-variables)
+ (when (get-buffer gnus-summary-buffer)
+ (kill-buffer gnus-summary-buffer)))
+ (unless gnus-single-article-buffer
+ (setq gnus-article-current nil))
+ (when gnus-use-trees
+ (gnus-tree-close group))
+ (gnus-async-prefetch-remove-group group)
+ (when (get-buffer gnus-article-buffer)
+ (bury-buffer gnus-article-buffer))
+ ;; Return to the group buffer.
+ (gnus-configure-windows 'group 'force)
+ ;; Clear the current group name.
+ (setq gnus-newsgroup-name nil)
+ (when (equal (gnus-group-group-name) group)
+ (gnus-group-next-unread-group 1))
+ (when quit-config
+ (gnus-handle-ephemeral-exit quit-config)))))
+
+(defun gnus-handle-ephemeral-exit (quit-config)
+ "Handle movement when leaving an ephemeral group. The state
+which existed when entering the ephemeral is reset."
+ (if (not (buffer-name (car quit-config)))
+ (gnus-configure-windows 'group 'force)
+ (set-buffer (car quit-config))
+ (cond ((eq major-mode 'gnus-summary-mode)
+ (gnus-set-global-variables))
+ ((eq major-mode 'gnus-article-mode)
+ (save-excursion
+ ;; The `gnus-summary-buffer' variable may point
+ ;; to the old summary buffer when using a single
+ ;; article buffer.
+ (unless (gnus-buffer-live-p gnus-summary-buffer)
+ (set-buffer gnus-group-buffer))
+ (set-buffer gnus-summary-buffer)
+ (gnus-set-global-variables))))
+ (if (or (eq (cdr quit-config) 'article)
+ (eq (cdr quit-config) 'pick))
+ (progn
+ ;; The current article may be from the ephemeral group
+ ;; thus it is best that we reload this article
+ (gnus-summary-show-article)
+ (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
+ (gnus-configure-windows 'pick 'force)
+ (gnus-configure-windows (cdr quit-config) 'force)))
+ (gnus-configure-windows (cdr quit-config) 'force))
+ (when (eq major-mode 'gnus-summary-mode)
+ (gnus-summary-next-subject 1 nil t)
+ (gnus-summary-recenter)
+ (gnus-summary-position-point))))
+
+;;; Dead summaries.
+
+(defvar gnus-dead-summary-mode-map nil)
+
+(unless gnus-dead-summary-mode-map
+ (setq gnus-dead-summary-mode-map (make-keymap))
+ (suppress-keymap gnus-dead-summary-mode-map)
+ (substitute-key-definition
+ 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
+ (let ((keys '("\C-d" "\r" "\177" [delete])))
+ (while keys
+ (define-key gnus-dead-summary-mode-map
+ (pop keys) 'gnus-summary-wake-up-the-dead))))
+
+(defvar gnus-dead-summary-mode nil
+ "Minor mode for Gnus summary buffers.")
+
+(defun gnus-dead-summary-mode (&optional arg)
+ "Minor mode for Gnus summary buffers."
+ (interactive "P")
+ (when (eq major-mode 'gnus-summary-mode)
+ (make-local-variable 'gnus-dead-summary-mode)
+ (setq gnus-dead-summary-mode
+ (if (null arg) (not gnus-dead-summary-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (when gnus-dead-summary-mode
+ (gnus-add-minor-mode
+ 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
+
+(defun gnus-deaden-summary ()
+ "Make the current summary buffer into a dead summary buffer."
+ ;; Kill any previous dead summary buffer.
+ (when (and gnus-dead-summary
+ (buffer-name gnus-dead-summary))
+ (save-excursion
+ (set-buffer gnus-dead-summary)
+ (when gnus-dead-summary-mode
+ (kill-buffer (current-buffer)))))
+ ;; Make this the current dead summary.
+ (setq gnus-dead-summary (current-buffer))
+ (gnus-dead-summary-mode 1)
+ (let ((name (buffer-name)))
+ (when (string-match "Summary" name)
+ (rename-buffer
+ (concat (substring name 0 (match-beginning 0)) "Dead "
+ (substring name (match-beginning 0)))
+ t))))
+
+(defun gnus-kill-or-deaden-summary (buffer)
+ "Kill or deaden the summary BUFFER."
+ (when (and (buffer-name buffer)
+ (not gnus-single-article-buffer))
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-kill-buffer gnus-article-buffer)
+ (gnus-kill-buffer gnus-original-article-buffer)))
+ (cond (gnus-kill-summary-on-exit
+ (when (and gnus-use-trees
+ (and (get-buffer buffer)
+ (buffer-name (get-buffer buffer))))
+ (save-excursion
+ (set-buffer (get-buffer buffer))
+ (gnus-tree-close gnus-newsgroup-name)))
+ (gnus-kill-buffer buffer))
+ ((and (get-buffer buffer)
+ (buffer-name (get-buffer buffer)))
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-deaden-summary)))))
+
+(defun gnus-summary-wake-up-the-dead (&rest args)
+ "Wake up the dead summary buffer."
+ (interactive)
+ (gnus-dead-summary-mode -1)
+ (let ((name (buffer-name)))
+ (when (string-match "Dead " name)
+ (rename-buffer
+ (concat (substring name 0 (match-beginning 0))
+ (substring name (match-end 0)))
+ t)))
+ (gnus-message 3 "This dead summary is now alive again"))
+
+;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
+(defun gnus-summary-fetch-faq (&optional faq-dir)
+ "Fetch the FAQ for the current group.
+If FAQ-DIR (the prefix), prompt for a directory to search for the faq
+in."
+ (interactive
+ (list
+ (when current-prefix-arg
+ (completing-read
+ "Faq dir: " (and (listp gnus-group-faq-directory)
+ (mapcar (lambda (file) (list file))
+ gnus-group-faq-directory))))))
+ (let (gnus-faq-buffer)
+ (when (setq gnus-faq-buffer
+ (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
+ (gnus-configure-windows 'summary-faq))))
+
+;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
+(defun gnus-summary-describe-group (&optional force)
+ "Describe the current newsgroup."
+ (interactive "P")
+ (gnus-group-describe-group force gnus-newsgroup-name))
+
+(defun gnus-summary-describe-briefly ()
+ "Describe summary mode commands briefly."
+ (interactive)
+ (gnus-message 6
+ (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
+
+;; Walking around group mode buffer from summary mode.
+
+(defun gnus-summary-next-group (&optional no-article target-group backward)
+ "Exit current newsgroup and then select next unread newsgroup.
+If prefix argument NO-ARTICLE is non-nil, no article is selected
+initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
+previous group instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ ;; Stop pre-fetching.
+ (gnus-async-halt-prefetch)
+ (let ((current-group gnus-newsgroup-name)
+ (current-buffer (current-buffer))
+ entered)
+ ;; First we semi-exit this group to update Xrefs and all variables.
+ ;; We can't do a real exit, because the window conf must remain
+ ;; the same in case the user is prompted for info, and we don't
+ ;; want the window conf to change before that...
+ (gnus-summary-exit t)
+ (while (not entered)
+ ;; Then we find what group we are supposed to enter.
+ (set-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group current-group)
+ (setq target-group
+ (or target-group
+ (if (eq gnus-keep-same-level 'best)
+ (gnus-summary-best-group gnus-newsgroup-name)
+ (gnus-summary-search-group backward gnus-keep-same-level))))
+ (if (not target-group)
+ ;; There are no further groups, so we return to the group
+ ;; buffer.
+ (progn
+ (gnus-message 5 "Returning to the group buffer")
+ (setq entered t)
+ (when (gnus-buffer-live-p current-buffer)
+ (set-buffer current-buffer)
+ (gnus-summary-exit))
+ (run-hooks 'gnus-group-no-more-groups-hook))
+ ;; We try to enter the target group.
+ (gnus-group-jump-to-group target-group)
+ (let ((unreads (gnus-group-group-unread)))
+ (if (and (or (eq t unreads)
+ (and unreads (not (zerop unreads))))
+ (gnus-summary-read-group
+ target-group nil no-article
+ (and (buffer-name current-buffer) current-buffer)))
+ (setq entered t)
+ (setq current-group target-group
+ target-group nil)))))))
+
+(defun gnus-summary-prev-group (&optional no-article)
+ "Exit current newsgroup and then select previous unread newsgroup.
+If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
+ (interactive "P")
+ (gnus-summary-next-group no-article nil t))
+
+;; Walking around summary lines.
+
+(defun gnus-summary-first-subject (&optional unread)
+ "Go to the first unread subject.
+If UNREAD is non-nil, go to the first unread article.
+Returns the article selected or nil if there are no unread articles."
+ (interactive "P")
+ (prog1
+ (cond
+ ;; Empty summary.
+ ((null gnus-newsgroup-data)
+ (gnus-message 3 "No articles in the group")
+ nil)
+ ;; Pick the first article.
+ ((not unread)
+ (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
+ (gnus-data-number (car gnus-newsgroup-data)))
+ ;; No unread articles.
+ ((null gnus-newsgroup-unreads)
+ (gnus-message 3 "No more unread articles")
+ nil)
+ ;; Find the first unread article.
+ (t
+ (let ((data gnus-newsgroup-data))
+ (while (and data
+ (not (gnus-data-unread-p (car data))))
+ (setq data (cdr data)))
+ (when data
+ (goto-char (gnus-data-pos (car data)))
+ (gnus-data-number (car data))))))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-next-subject (n &optional unread dont-display)
+ "Go to next N'th summary line.
+If N is negative, go to the previous N'th subject line.
+If UNREAD is non-nil, only unread articles are selected.
+The difference between N and the actual number of steps taken is
+returned."
+ (interactive "p")
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (while (and (> n 0)
+ (if backward
+ (gnus-summary-find-prev unread)
+ (gnus-summary-find-next unread)))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more%s articles"
+ (if unread " unread" "")))
+ (unless dont-display
+ (gnus-summary-recenter)
+ (gnus-summary-position-point))
+ n))
+
+(defun gnus-summary-next-unread-subject (n)
+ "Go to next N'th unread summary line."
+ (interactive "p")
+ (gnus-summary-next-subject n t))
+
+(defun gnus-summary-prev-subject (n &optional unread)
+ "Go to previous N'th summary line.
+If optional argument UNREAD is non-nil, only unread article is selected."
+ (interactive "p")
+ (gnus-summary-next-subject (- n) unread))
+
+(defun gnus-summary-prev-unread-subject (n)
+ "Go to previous N'th unread summary line."
+ (interactive "p")
+ (gnus-summary-next-subject (- n) t))
+
+(defun gnus-summary-goto-subject (article &optional force silent)
+ "Go the subject line of ARTICLE.
+If FORCE, also allow jumping to articles not currently shown."
+ (interactive "nArticle number: ")
+ (let ((b (point))
+ (data (gnus-data-find article)))
+ ;; We read in the article if we have to.
+ (and (not data)
+ force
+ (gnus-summary-insert-subject article (and (vectorp force) force) t)
+ (setq data (gnus-data-find article)))
+ (goto-char b)
+ (if (not data)
+ (progn
+ (unless silent
+ (gnus-message 3 "Can't find article %d" article))
+ nil)
+ (goto-char (gnus-data-pos data))
+ article)))
+
+;; Walking around summary lines with displaying articles.
+
+(defun gnus-summary-expand-window (&optional arg)
+ "Make the summary buffer take up the entire Emacs frame.
+Given a prefix, will force an `article' buffer configuration."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (if arg
+ (gnus-configure-windows 'article 'force)
+ (gnus-configure-windows 'summary 'force)))
+
+(defun gnus-summary-display-article (article &optional all-header)
+ "Display ARTICLE in article buffer."
+ (gnus-set-global-variables)
+ (if (null article)
+ nil
+ (prog1
+ (if gnus-summary-display-article-function
+ (funcall gnus-summary-display-article-function article all-header)
+ (gnus-article-prepare article all-header))
+ (run-hooks 'gnus-select-article-hook)
+ (when (and gnus-current-article
+ (not (zerop gnus-current-article)))
+ (gnus-summary-goto-subject gnus-current-article))
+ (gnus-summary-recenter)
+ (when (and gnus-use-trees gnus-show-threads)
+ (gnus-possibly-generate-tree article)
+ (gnus-highlight-selected-tree article))
+ ;; Successfully display article.
+ (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks))))))
+
+(defun gnus-summary-select-article (&optional all-headers force pseudo article)
+ "Select the current article.
+If ALL-HEADERS is non-nil, show all header fields. If FORCE is
+non-nil, the article will be re-fetched even if it already present in
+the article buffer. If PSEUDO is non-nil, pseudo-articles will also
+be displayed."
+ ;; Make sure we are in the summary buffer to work around bbdb bug.
+ (unless (eq major-mode 'gnus-summary-mode)
+ (set-buffer gnus-summary-buffer))
+ (let ((article (or article (gnus-summary-article-number)))
+ (all-headers (not (not all-headers))) ;Must be T or NIL.
+ gnus-summary-display-article-function
+ did)
+ (and (not pseudo)
+ (gnus-summary-article-pseudo-p article)
+ (error "This is a pseudo-article"))
+ (prog1
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (if (or (and gnus-single-article-buffer
+ (or (null gnus-current-article)
+ (null gnus-article-current)
+ (null (get-buffer gnus-article-buffer))
+ (not (eq article (cdr gnus-article-current)))
+ (not (equal (car gnus-article-current)
+ gnus-newsgroup-name))))
+ (and (not gnus-single-article-buffer)
+ (or (null gnus-current-article)
+ (not (eq gnus-current-article article))))
+ force)
+ ;; The requested article is different from the current article.
+ (prog1
+ (gnus-summary-display-article article all-headers)
+ (setq did article))
+ (when (or all-headers gnus-show-all-headers)
+ (gnus-article-show-all-headers))
+ 'old))
+ (when did
+ (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks)))))))
+
+(defun gnus-summary-set-current-mark (&optional current-mark)
+ "Obsolete function."
+ nil)
+
+(defun gnus-summary-next-article (&optional unread subject backward push)
+ "Select the next article.
+If UNREAD, only unread articles are selected.
+If SUBJECT, only articles with SUBJECT are selected.
+If BACKWARD, the previous article is selected instead of the next."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (cond
+ ;; Is there such an article?
+ ((and (gnus-summary-search-forward unread subject backward)
+ (or (gnus-summary-display-article (gnus-summary-article-number))
+ (eq (gnus-summary-article-mark) gnus-canceled-mark)))
+ (gnus-summary-position-point))
+ ;; If not, we try the first unread, if that is wanted.
+ ((and subject
+ gnus-auto-select-same
+ (gnus-summary-first-unread-article))
+ (gnus-summary-position-point)
+ (gnus-message 6 "Wrapped"))
+ ;; Try to get next/previous article not displayed in this group.
+ ((and gnus-auto-extend-newsgroup
+ (not unread) (not subject))
+ (gnus-summary-goto-article
+ (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
+ nil t))
+ ;; Go to next/previous group.
+ (t
+ (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-summary-jump-to-group gnus-newsgroup-name))
+ (let ((cmd last-command-char)
+ (point
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (point)))
+ (group
+ (if (eq gnus-keep-same-level 'best)
+ (gnus-summary-best-group gnus-newsgroup-name)
+ (gnus-summary-search-group backward gnus-keep-same-level))))
+ ;; For some reason, the group window gets selected. We change
+ ;; it back.
+ (select-window (get-buffer-window (current-buffer)))
+ ;; Select next unread newsgroup automagically.
+ (cond
+ ((or (not gnus-auto-select-next)
+ (not cmd))
+ (gnus-message 7 "No more%s articles" (if unread " unread" "")))
+ ((or (eq gnus-auto-select-next 'quietly)
+ (and (eq gnus-auto-select-next 'slightly-quietly)
+ push)
+ (and (eq gnus-auto-select-next 'almost-quietly)
+ (gnus-summary-last-article-p)))
+ ;; Select quietly.
+ (if (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-summary-exit)
+ (gnus-message 7 "No more%s articles (%s)..."
+ (if unread " unread" "")
+ (if group (concat "selecting " group)
+ "exiting"))
+ (gnus-summary-next-group nil group backward)))
+ (t
+ (when (gnus-key-press-event-p last-input-event)
+ (gnus-summary-walk-group-buffer
+ gnus-newsgroup-name cmd unread backward point))))))))
+
+(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start)
+ (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
+ (?\C-p (gnus-group-prev-unread-group 1))))
+ (cursor-in-echo-area t)
+ keve key group ended)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (goto-char start)
+ (setq group
+ (if (eq gnus-keep-same-level 'best)
+ (gnus-summary-best-group gnus-newsgroup-name)
+ (gnus-summary-search-group backward gnus-keep-same-level))))
+ (while (not ended)
+ (gnus-message
+ 5 "No more%s articles%s" (if unread " unread" "")
+ (if (and group
+ (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
+ (format " (Type %s for %s [%s])"
+ (single-key-description cmd) group
+ (car (gnus-gethash group gnus-newsrc-hashtb)))
+ (format " (Type %s to exit %s)"
+ (single-key-description cmd)
+ gnus-newsgroup-name)))
+ ;; Confirm auto selection.
+ (setq key (car (setq keve (gnus-read-event-char))))
+ (setq ended t)
+ (cond
+ ((assq key keystrokes)
+ (let ((obuf (current-buffer)))
+ (switch-to-buffer gnus-group-buffer)
+ (when group
+ (gnus-group-jump-to-group group))
+ (eval (cadr (assq key keystrokes)))
+ (setq group (gnus-group-group-name))
+ (switch-to-buffer obuf))
+ (setq ended nil))
+ ((equal key cmd)
+ (if (or (not group)
+ (gnus-ephemeral-group-p gnus-newsgroup-name))
+ (gnus-summary-exit)
+ (gnus-summary-next-group nil group backward)))
+ (t
+ (push (cdr keve) unread-command-events))))))
+
+(defun gnus-summary-next-unread-article ()
+ "Select unread article after current one."
+ (interactive)
+ (gnus-summary-next-article
+ (or (not (eq gnus-summary-goto-unread 'never))
+ (gnus-summary-last-article-p (gnus-summary-article-number)))
+ (and gnus-auto-select-same
+ (gnus-summary-article-subject))))
+
+(defun gnus-summary-prev-article (&optional unread subject)
+ "Select the article after the current one.
+If UNREAD is non-nil, only unread articles are selected."
+ (interactive "P")
+ (gnus-summary-next-article unread subject t))
+
+(defun gnus-summary-prev-unread-article ()
+ "Select unread article before current one."
+ (interactive)
+ (gnus-summary-prev-article
+ (or (not (eq gnus-summary-goto-unread 'never))
+ (gnus-summary-first-article-p (gnus-summary-article-number)))
+ (and gnus-auto-select-same
+ (gnus-summary-article-subject))))
+
+(defun gnus-summary-next-page (&optional lines circular)
+ "Show next page of the selected article.
+If at the end of the current article, select the next article.
+LINES says how many lines should be scrolled up.
+
+If CIRCULAR is non-nil, go to the start of the article instead of
+selecting the next article when reaching the end of the current
+article."
+ (interactive "P")
+ (setq gnus-summary-buffer (current-buffer))
+ (gnus-set-global-variables)
+ (let ((article (gnus-summary-article-number))
+ (article-window (get-buffer-window gnus-article-buffer t))
+ endp)
+ (gnus-configure-windows 'article)
+ (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-last-article-p article)))
+ (gnus-summary-next-article)
+ (gnus-summary-next-unread-article))
+ (if (or (null gnus-current-article)
+ (null gnus-article-current)
+ (/= article (cdr gnus-article-current))
+ (not (equal (car gnus-article-current) gnus-newsgroup-name)))
+ ;; Selected subject is different from current article's.
+ (gnus-summary-display-article article)
+ (when article-window
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (setq endp (gnus-article-next-page lines)))
+ (when endp
+ (cond (circular
+ (gnus-summary-beginning-of-article))
+ (lines
+ (gnus-message 3 "End of message"))
+ ((null lines)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-last-article-p article)))
+ (gnus-summary-next-article)
+ (gnus-summary-next-unread-article))))))))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-prev-page (&optional lines move)
+ "Show previous page of selected article.
+Argument LINES specifies lines to be scrolled down.
+If MOVE, move to the previous unread article if point is at
+the beginning of the buffer."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((article (gnus-summary-article-number))
+ (article-window (get-buffer-window gnus-article-buffer t))
+ endp)
+ (gnus-configure-windows 'article)
+ (if (or (null gnus-current-article)
+ (null gnus-article-current)
+ (/= article (cdr gnus-article-current))
+ (not (equal (car gnus-article-current) gnus-newsgroup-name)))
+ ;; Selected subject is different from current article's.
+ (gnus-summary-display-article article)
+ (gnus-summary-recenter)
+ (when article-window
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (setq endp (gnus-article-prev-page lines)))
+ (when (and move endp)
+ (cond (lines
+ (gnus-message 3 "Beginning of message"))
+ ((null lines)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-first-article-p article)))
+ (gnus-summary-prev-article)
+ (gnus-summary-prev-unread-article))))))))
+ (gnus-summary-position-point))
+
+(defun gnus-summary-prev-page-or-article (&optional lines)
+ "Show previous page of selected article.
+Argument LINES specifies lines to be scrolled down.
+If at the beginning of the article, go to the next article."
+ (interactive "P")
+ (gnus-summary-prev-page lines t))
+
+(defun gnus-summary-scroll-up (lines)
+ "Scroll up (or down) one line current article.
+Argument LINES specifies lines to be scrolled up (or down if negative)."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-configure-windows 'article)
+ (gnus-summary-show-thread)
+ (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (cond ((> lines 0)
+ (when (gnus-article-next-page lines)
+ (gnus-message 3 "End of message")))
+ ((< lines 0)
+ (gnus-article-prev-page (- lines))))))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point))
+
+(defun gnus-summary-next-same-subject ()
+ "Select next article which has the same subject as current one."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-next-article nil (gnus-summary-article-subject)))
+
+(defun gnus-summary-prev-same-subject ()
+ "Select previous article which has the same subject as current one."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-prev-article nil (gnus-summary-article-subject)))
+
+(defun gnus-summary-next-unread-same-subject ()
+ "Select next unread article which has the same subject as current one."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-next-article t (gnus-summary-article-subject)))
+
+(defun gnus-summary-prev-unread-same-subject ()
+ "Select previous unread article which has the same subject as current one."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-prev-article t (gnus-summary-article-subject)))
+
+(defun gnus-summary-first-unread-article ()
+ "Select the first unread article.
+Return nil if there are no unread articles."
+ (interactive)
+ (gnus-set-global-variables)
+ (prog1
+ (when (gnus-summary-first-subject t)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject t)
+ (gnus-summary-display-article (gnus-summary-article-number)))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-first-article ()
+ "Select the first article.
+Return nil if there are no articles."
+ (interactive)
+ (gnus-set-global-variables)
+ (prog1
+ (when (gnus-summary-first-subject)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject)
+ (gnus-summary-display-article (gnus-summary-article-number)))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-best-unread-article ()
+ "Select the unread article with the highest score."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((best -1000000)
+ (data gnus-newsgroup-data)
+ article score)
+ (while data
+ (and (gnus-data-unread-p (car data))
+ (> (setq score
+ (gnus-summary-article-score (gnus-data-number (car data))))
+ best)
+ (setq best score
+ article (gnus-data-number (car data))))
+ (setq data (cdr data)))
+ (prog1
+ (if article
+ (gnus-summary-goto-article article)
+ (error "No unread articles"))
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-last-subject ()
+ "Go to the last displayed subject line in the group."
+ (let ((article (gnus-data-number (car (gnus-data-list t)))))
+ (when article
+ (gnus-summary-goto-subject article))))
+
+(defun gnus-summary-goto-article (article &optional all-headers force)
+ "Fetch ARTICLE (article number or Message-ID) and display it if it exists.
+If ALL-HEADERS is non-nil, no header lines are hidden."
+ (interactive
+ (list
+ (completing-read
+ "Article number or Message-ID: "
+ (mapcar (lambda (number) (list (int-to-string number)))
+ gnus-newsgroup-limit))
+ current-prefix-arg
+ t))
+ (prog1
+ (if (and (stringp article)
+ (string-match "@" article))
+ (gnus-summary-refer-article article)
+ (when (stringp article)
+ (setq article (string-to-number article)))
+ (if (gnus-summary-goto-subject article force)
+ (gnus-summary-display-article article all-headers)
+ (gnus-message 4 "Couldn't go to article %s" article) nil))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-goto-last-article ()
+ "Go to the previously read article."
+ (interactive)
+ (prog1
+ (when gnus-last-article
+ (gnus-summary-goto-article gnus-last-article))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-pop-article (number)
+ "Pop one article off the history and go to the previous.
+NUMBER articles will be popped off."
+ (interactive "p")
+ (let (to)
+ (setq gnus-newsgroup-history
+ (cdr (setq to (nthcdr number gnus-newsgroup-history))))
+ (if to
+ (gnus-summary-goto-article (car to))
+ (error "Article history empty")))
+ (gnus-summary-position-point))
+
+;; Summary commands and functions for limiting the summary buffer.
+
+(defun gnus-summary-limit-to-articles (n)
+ "Limit the summary buffer to the next N articles.
+If not given a prefix, use the process marked articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (prog1
+ (let ((articles (gnus-summary-work-articles n)))
+ (setq gnus-newsgroup-processable nil)
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-pop-limit (&optional total)
+ "Restore the previous limit.
+If given a prefix, remove all limits."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (when total
+ (setq gnus-newsgroup-limits
+ (list (mapcar (lambda (h) (mail-header-number h))
+ gnus-newsgroup-headers))))
+ (unless gnus-newsgroup-limits
+ (error "No limit to pop"))
+ (prog1
+ (gnus-summary-limit nil 'pop)
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-limit-to-subject (subject &optional header)
+ "Limit the summary buffer to articles that have subjects that match a regexp."
+ (interactive "sLimit to subject (regexp): ")
+ (unless header
+ (setq header "subject"))
+ (when (not (equal "" subject))
+ (prog1
+ (let ((articles (gnus-summary-find-matching
+ (or header "subject") subject 'all)))
+ (unless articles
+ (error "Found no matches for \"%s\"" subject))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-to-author (from)
+ "Limit the summary buffer to articles that have authors that match a regexp."
+ (interactive "sLimit to author (regexp): ")
+ (gnus-summary-limit-to-subject from "from"))
+
+(defun gnus-summary-limit-to-age (age &optional younger-p)
+ "Limit the summary buffer to articles that are older than (or equal) AGE days.
+If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
+articles that are younger than AGE days."
+ (interactive "nTime in days: \nP")
+ (prog1
+ (let ((data gnus-newsgroup-data)
+ (cutoff (nnmail-days-to-time age))
+ articles d date is-younger)
+ (while (setq d (pop data))
+ (when (and (vectorp (gnus-data-header d))
+ (setq date (mail-header-date (gnus-data-header d))))
+ (setq is-younger (nnmail-time-less
+ (nnmail-time-since (nnmail-date-to-time date))
+ cutoff))
+ (when (if younger-p is-younger (not is-younger))
+ (push (gnus-data-number d) articles))))
+ (gnus-summary-limit (nreverse articles)))
+ (gnus-summary-position-point)))
+
+(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
+(make-obsolete
+ 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
+
+(defun gnus-summary-limit-to-unread (&optional all)
+ "Limit the summary buffer to articles that are not marked as read.
+If ALL is non-nil, limit strictly to unread articles."
+ (interactive "P")
+ (if all
+ (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
+ (gnus-summary-limit-to-marks
+ ;; Concat all the marks that say that an article is read and have
+ ;; those removed.
+ (list gnus-del-mark gnus-read-mark gnus-ancient-mark
+ gnus-killed-mark gnus-kill-file-mark
+ gnus-low-score-mark gnus-expirable-mark
+ gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
+ gnus-duplicate-mark gnus-souped-mark)
+ 'reverse)))
+
+(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
+(make-obsolete 'gnus-summary-delete-marked-with
+ 'gnus-summary-limit-exlude-marks)
+
+(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
+ "Exclude articles that are marked with MARKS (e.g. \"DK\").
+If REVERSE, limit the summary buffer to articles that are marked
+with MARKS. MARKS can either be a string of marks or a list of marks.
+Returns how many articles were removed."
+ (interactive "sMarks: ")
+ (gnus-summary-limit-to-marks marks t))
+
+(defun gnus-summary-limit-to-marks (marks &optional reverse)
+ "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
+If REVERSE (the prefix), limit the summary buffer to articles that are
+not marked with MARKS. MARKS can either be a string of marks or a
+list of marks.
+Returns how many articles were removed."
+ (interactive "sMarks: \nP")
+ (gnus-set-global-variables)
+ (prog1
+ (let ((data gnus-newsgroup-data)
+ (marks (if (listp marks) marks
+ (append marks nil))) ; Transform to list.
+ articles)
+ (while data
+ (when (if reverse (not (memq (gnus-data-mark (car data)) marks))
+ (memq (gnus-data-mark (car data)) marks))
+ (push (gnus-data-number (car data)) articles))
+ (setq data (cdr data)))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-limit-to-score (&optional score)
+ "Limit to articles with score at or above SCORE."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (setq score (if score
+ (prefix-numeric-value score)
+ (or gnus-summary-default-score 0)))
+ (let ((data gnus-newsgroup-data)
+ articles)
+ (while data
+ (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
+ score)
+ (push (gnus-data-number (car data)) articles))
+ (setq data (cdr data)))
+ (prog1
+ (gnus-summary-limit articles)
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-include-thread (id)
+ "Display all the hidden articles that in the current thread."
+ (interactive (mail-header-id (gnus-summary-article-header)))
+ (gnus-set-global-variables)
+ (let ((articles (gnus-articles-in-thread
+ (gnus-id-to-thread (gnus-root-id id)))))
+ (prog1
+ (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-include-dormant ()
+ "Display all the hidden articles that are marked as dormant."
+ (interactive)
+ (gnus-set-global-variables)
+ (unless gnus-newsgroup-dormant
+ (error "There are no dormant articles in this group"))
+ (prog1
+ (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-limit-exclude-dormant ()
+ "Hide all dormant articles."
+ (interactive)
+ (gnus-set-global-variables)
+ (prog1
+ (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-limit-exclude-childless-dormant ()
+ "Hide all dormant articles that have no children."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((data (gnus-data-list t))
+ articles d children)
+ ;; Find all articles that are either not dormant or have
+ ;; children.
+ (while (setq d (pop data))
+ (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
+ (and (setq children
+ (gnus-article-children (gnus-data-number d)))
+ (let (found)
+ (while children
+ (when (memq (car children) articles)
+ (setq children nil
+ found t))
+ (pop children))
+ found)))
+ (push (gnus-data-number d) articles)))
+ ;; Do the limiting.
+ (prog1
+ (gnus-summary-limit articles)
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-mark-excluded-as-read (&optional all)
+ "Mark all unread excluded articles as read.
+If ALL, mark even excluded ticked and dormants as read."
+ (interactive "P")
+ (let ((articles (gnus-sorted-complement
+ (sort
+ (mapcar (lambda (h) (mail-header-number h))
+ gnus-newsgroup-headers)
+ '<)
+ (sort gnus-newsgroup-limit '<)))
+ article)
+ (setq gnus-newsgroup-unreads gnus-newsgroup-limit)
+ (if all
+ (setq gnus-newsgroup-dormant nil
+ gnus-newsgroup-marked nil
+ gnus-newsgroup-reads
+ (nconc
+ (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
+ gnus-newsgroup-reads))
+ (while (setq article (pop articles))
+ (unless (or (memq article gnus-newsgroup-dormant)
+ (memq article gnus-newsgroup-marked))
+ (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
+
+(defun gnus-summary-limit (articles &optional pop)
+ (if pop
+ ;; We pop the previous limit off the stack and use that.
+ (setq articles (car gnus-newsgroup-limits)
+ gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
+ ;; We use the new limit, so we push the old limit on the stack.
+ (push gnus-newsgroup-limit gnus-newsgroup-limits))
+ ;; Set the limit.
+ (setq gnus-newsgroup-limit articles)
+ (let ((total (length gnus-newsgroup-data))
+ (data (gnus-data-find-list (gnus-summary-article-number)))
+ (gnus-summary-mark-below nil) ; Inhibit this.
+ found)
+ ;; This will do all the work of generating the new summary buffer
+ ;; according to the new limit.
+ (gnus-summary-prepare)
+ ;; Hide any threads, possibly.
+ (and gnus-show-threads
+ gnus-thread-hide-subtree
+ (gnus-summary-hide-all-threads))
+ ;; Try to return to the article you were at, or one in the
+ ;; neighborhood.
+ (when data
+ ;; We try to find some article after the current one.
+ (while data
+ (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t)
+ (setq data nil
+ found t))
+ (setq data (cdr data))))
+ (unless found
+ ;; If there is no data, that means that we were after the last
+ ;; article. The same goes when we can't find any articles
+ ;; after the current one.
+ (goto-char (point-max))
+ (gnus-summary-find-prev))
+ ;; We return how many articles were removed from the summary
+ ;; buffer as a result of the new limit.
+ (- total (length gnus-newsgroup-data))))
+
+(defsubst gnus-invisible-cut-children (threads)
+ (let ((num 0))
+ (while threads
+ (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
+ (incf num))
+ (pop threads))
+ (< num 2)))
+
+(defsubst gnus-cut-thread (thread)
+ "Go forwards in the thread until we find an article that we want to display."
+ (when (or (eq gnus-fetch-old-headers 'some)
+ (eq gnus-fetch-old-headers 'invisible)
+ (eq gnus-build-sparse-threads 'some)
+ (eq gnus-build-sparse-threads 'more))
+ ;; Deal with old-fetched headers and sparse threads.
+ (while (and
+ thread
+ (or
+ (gnus-summary-article-sparse-p (mail-header-number (car thread)))
+ (gnus-summary-article-ancient-p
+ (mail-header-number (car thread))))
+ (if (or (<= (length (cdr thread)) 1)
+ (eq gnus-fetch-old-headers 'invisible))
+ (setq gnus-newsgroup-limit
+ (delq (mail-header-number (car thread))
+ gnus-newsgroup-limit)
+ thread (cadr thread))
+ (when (gnus-invisible-cut-children (cdr thread))
+ (let ((th (cdr thread)))
+ (while th
+ (if (memq (mail-header-number (caar th))
+ gnus-newsgroup-limit)
+ (setq thread (car th)
+ th nil)
+ (setq th (cdr th))))))))))
+ thread)
+
+(defun gnus-cut-threads (threads)
+ "Cut off all uninteresting articles from the beginning of threads."
+ (when (or (eq gnus-fetch-old-headers 'some)
+ (eq gnus-fetch-old-headers 'invisible)
+ (eq gnus-build-sparse-threads 'some)
+ (eq gnus-build-sparse-threads 'more))
+ (let ((th threads))
+ (while th
+ (setcar th (gnus-cut-thread (car th)))
+ (setq th (cdr th)))))
+ ;; Remove nixed out threads.
+ (delq nil threads))
+
+(defun gnus-summary-initial-limit (&optional show-if-empty)
+ "Figure out what the initial limit is supposed to be on group entry.
+This entails weeding out unwanted dormants, low-scored articles,
+fetch-old-headers verbiage, and so on."
+ ;; Most groups have nothing to remove.
+ (if (or gnus-inhibit-limiting
+ (and (null gnus-newsgroup-dormant)
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (eq gnus-fetch-old-headers 'invisible))
+ (null gnus-summary-expunge-below)
+ (not (eq gnus-build-sparse-threads 'some))
+ (not (eq gnus-build-sparse-threads 'more))
+ (null gnus-thread-expunge-below)
+ (not gnus-use-nocem)))
+ () ; Do nothing.
+ (push gnus-newsgroup-limit gnus-newsgroup-limits)
+ (setq gnus-newsgroup-limit nil)
+ (mapatoms
+ (lambda (node)
+ (unless (car (symbol-value node))
+ ;; These threads have no parents -- they are roots.
+ (let ((nodes (cdr (symbol-value node)))
+ thread)
+ (while nodes
+ (if (and gnus-thread-expunge-below
+ (< (gnus-thread-total-score (car nodes))
+ gnus-thread-expunge-below))
+ (gnus-expunge-thread (pop nodes))
+ (setq thread (pop nodes))
+ (gnus-summary-limit-children thread))))))
+ gnus-newsgroup-dependencies)
+ ;; If this limitation resulted in an empty group, we might
+ ;; pop the previous limit and use it instead.
+ (when (and (not gnus-newsgroup-limit)
+ show-if-empty)
+ (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
+ gnus-newsgroup-limit))
+
+(defun gnus-summary-limit-children (thread)
+ "Return 1 if this subthread is visible and 0 if it is not."
+ ;; First we get the number of visible children to this thread. This
+ ;; is done by recursing down the thread using this function, so this
+ ;; will really go down to a leaf article first, before slowly
+ ;; working its way up towards the root.
+ (when thread
+ (let ((children
+ (if (cdr thread)
+ (apply '+ (mapcar 'gnus-summary-limit-children
+ (cdr thread)))
+ 0))
+ (number (mail-header-number (car thread)))
+ score)
+ (if (and
+ (not (memq number gnus-newsgroup-marked))
+ (or
+ ;; If this article is dormant and has absolutely no visible
+ ;; children, then this article isn't visible.
+ (and (memq number gnus-newsgroup-dormant)
+ (zerop children))
+ ;; If this is "fetch-old-headered" and there is no
+ ;; visible children, then we don't want this article.
+ (and (eq gnus-fetch-old-headers 'some)
+ (gnus-summary-article-ancient-p number)
+ (zerop children))
+ ;; If this is "fetch-old-headered" and `invisible', then
+ ;; we don't want this article.
+ (and (eq gnus-fetch-old-headers 'invisible)
+ (gnus-summary-article-ancient-p number))
+ ;; If this is a sparsely inserted article with no children,
+ ;; we don't want it.
+ (and (eq gnus-build-sparse-threads 'some)
+ (gnus-summary-article-sparse-p number)
+ (zerop children))
+ ;; If we use expunging, and this article is really
+ ;; low-scored, then we don't want this article.
+ (when (and gnus-summary-expunge-below
+ (< (setq score
+ (or (cdr (assq number gnus-newsgroup-scored))
+ gnus-summary-default-score))
+ gnus-summary-expunge-below))
+ ;; We increase the expunge-tally here, but that has
+ ;; nothing to do with the limits, really.
+ (incf gnus-newsgroup-expunged-tally)
+ ;; We also mark as read here, if that's wanted.
+ (when (and gnus-summary-mark-below
+ (< score gnus-summary-mark-below))
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ (if gnus-newsgroup-auto-expire
+ (push number gnus-newsgroup-expirable)
+ (push (cons number gnus-low-score-mark)
+ gnus-newsgroup-reads)))
+ t)
+ ;; Check NoCeM things.
+ (if (and gnus-use-nocem
+ (gnus-nocem-unwanted-article-p
+ (mail-header-id (car thread))))
+ (progn
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ t))))
+ ;; Nope, invisible article.
+ 0
+ ;; Ok, this article is to be visible, so we add it to the limit
+ ;; and return 1.
+ (push number gnus-newsgroup-limit)
+ 1))))
+
+(defun gnus-expunge-thread (thread)
+ "Mark all articles in THREAD as read."
+ (let* ((number (mail-header-number (car thread))))
+ (incf gnus-newsgroup-expunged-tally)
+ ;; We also mark as read here, if that's wanted.
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ (if gnus-newsgroup-auto-expire
+ (push number gnus-newsgroup-expirable)
+ (push (cons number gnus-low-score-mark)
+ gnus-newsgroup-reads)))
+ ;; Go recursively through all subthreads.
+ (mapcar 'gnus-expunge-thread (cdr thread)))
+
+;; Summary article oriented commands
+
+(defun gnus-summary-refer-parent-article (n)
+ "Refer parent article N times.
+If N is negative, go to ancestor -N instead.
+The difference between N and the number of articles fetched is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (let ((skip 1)
+ error header ref)
+ (when (not (natnump n))
+ (setq skip (abs n)
+ n 1))
+ (while (and (> n 0)
+ (not error))
+ (setq header (gnus-summary-article-header))
+ (if (and (eq (mail-header-number header)
+ (cdr gnus-article-current))
+ (equal gnus-newsgroup-name
+ (car gnus-article-current)))
+ ;; If we try to find the parent of the currently
+ ;; displayed article, then we take a look at the actual
+ ;; References header, since this is slightly more
+ ;; reliable than the References field we got from the
+ ;; server.
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (nnheader-narrow-to-headers)
+ (unless (setq ref (message-fetch-field "references"))
+ (setq ref (message-fetch-field "in-reply-to")))
+ (widen))
+ (setq ref
+ ;; It's not the current article, so we take a bet on
+ ;; the value we got from the server.
+ (mail-header-references header)))
+ (if (and ref
+ (not (equal ref "")))
+ (unless (gnus-summary-refer-article (gnus-parent-id ref skip))
+ (gnus-message 1 "Couldn't find parent"))
+ (gnus-message 1 "No references in article %d"
+ (gnus-summary-article-number))
+ (setq error t))
+ (decf n))
+ (gnus-summary-position-point)
+ n))
+
+(defun gnus-summary-refer-references ()
+ "Fetch all articles mentioned in the References header.
+Return the number of articles fetched."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((ref (mail-header-references (gnus-summary-article-header)))
+ (current (gnus-summary-article-number))
+ (n 0))
+ (if (or (not ref)
+ (equal ref ""))
+ (error "No References in the current article")
+ ;; For each Message-ID in the References header...
+ (while (string-match "<[^>]*>" ref)
+ (incf n)
+ ;; ... fetch that article.
+ (gnus-summary-refer-article
+ (prog1 (match-string 0 ref)
+ (setq ref (substring ref (match-end 0))))))
+ (gnus-summary-goto-subject current)
+ (gnus-summary-position-point)
+ n)))
+
+(defun gnus-summary-refer-thread (&optional limit)
+ "Fetch all articles in the current thread.
+If LIMIT (the numerical prefix), fetch that many old headers instead
+of what's specified by the `gnus-refer-thread-limit' variable."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((id (mail-header-id (gnus-summary-article-header)))
+ (limit (if limit (prefix-numeric-value limit)
+ gnus-refer-thread-limit))
+ fmethod root)
+ ;; We want to fetch LIMIT *old* headers, but we also have to
+ ;; re-fetch all the headers in the current buffer, because many of
+ ;; them may be undisplayed. So we adjust LIMIT.
+ (when (numberp limit)
+ (incf limit (- gnus-newsgroup-end gnus-newsgroup-begin)))
+ (unless (eq gnus-fetch-old-headers 'invisible)
+ (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
+ ;; Retrieve the headers and read them in.
+ (if (eq (gnus-retrieve-headers
+ (list gnus-newsgroup-end) gnus-newsgroup-name limit)
+ 'nov)
+ (gnus-build-all-threads)
+ (error "Can't fetch thread from backends that don't support NOV"))
+ (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
+ (gnus-summary-limit-include-thread id)))
+
+(defun gnus-summary-refer-article (message-id &optional arg)
+ "Fetch an article specified by MESSAGE-ID.
+If ARG (the prefix), fetch the article using `gnus-refer-article-method'
+or `gnus-select-method', no matter what backend the article comes from."
+ (interactive "sMessage-ID: \nP")
+ (when (and (stringp message-id)
+ (not (zerop (length message-id))))
+ ;; Construct the correct Message-ID if necessary.
+ ;; Suggested by tale@pawl.rpi.edu.
+ (unless (string-match "^<" message-id)
+ (setq message-id (concat "<" message-id)))
+ (unless (string-match ">$" message-id)
+ (setq message-id (concat message-id ">")))
+ (let* ((header (gnus-id-to-header message-id))
+ (sparse (and header
+ (gnus-summary-article-sparse-p
+ (mail-header-number header))
+ (memq (mail-header-number header)
+ gnus-newsgroup-limit))))
+ (if (and header
+ (or (not (gnus-summary-article-sparse-p
+ (mail-header-number header)))
+ sparse))
+ (prog1
+ ;; The article is present in the buffer, so we just go to it.
+ (gnus-summary-goto-article
+ (mail-header-number header) nil t)
+ (when sparse
+ (gnus-summary-update-article (mail-header-number header))))
+ ;; We fetch the article
+ (let ((gnus-override-method
+ (cond ((gnus-news-group-p gnus-newsgroup-name)
+ gnus-refer-article-method)
+ (arg
+ (or gnus-refer-article-method gnus-select-method))
+ (t nil)))
+ number)
+ ;; Start the special refer-article method, if necessary.
+ (when (and gnus-refer-article-method
+ (gnus-news-group-p gnus-newsgroup-name))
+ (gnus-check-server gnus-refer-article-method))
+ ;; Fetch the header, and display the article.
+ (if (setq number (gnus-summary-insert-subject message-id))
+ (gnus-summary-select-article nil nil nil number)
+ (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
+
+(defun gnus-summary-enter-digest-group (&optional force)
+ "Enter an nndoc group based on the current article.
+If FORCE, force a digest interpretation. If not, try
+to guess what the document format is."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((conf gnus-current-window-configuration))
+ (save-excursion
+ (gnus-summary-select-article))
+ (setq gnus-current-window-configuration conf)
+ (let* ((name (format "%s-%d"
+ (gnus-group-prefixed-name
+ gnus-newsgroup-name (list 'nndoc ""))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-current-article)))
+ (ogroup gnus-newsgroup-name)
+ (params (append (gnus-info-params (gnus-get-info ogroup))
+ (list (cons 'to-group ogroup))
+ (list (cons 'save-article-group ogroup))))
+ (case-fold-search t)
+ (buf (current-buffer))
+ dig)
+ (save-excursion
+ (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
+ (insert-buffer-substring gnus-original-article-buffer)
+ ;; Remove lines that may lead nndoc to misinterpret the
+ ;; document type.
+ (narrow-to-region
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point)))
+ (goto-char (point-min))
+ (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (widen))
+ (unwind-protect
+ (if (gnus-group-read-ephemeral-group
+ name `(nndoc ,name (nndoc-address ,(get-buffer dig))
+ (nndoc-article-type
+ ,(if force 'digest 'guess))) t)
+ ;; Make all postings to this group go to the parent group.
+ (nconc (gnus-info-params (gnus-get-info name))
+ params)
+ ;; Couldn't select this doc group.
+ (switch-to-buffer buf)
+ (gnus-set-global-variables)
+ (gnus-configure-windows 'summary)
+ (gnus-message 3 "Article couldn't be entered?"))
+ (kill-buffer dig)))))
+
+(defun gnus-summary-read-document (n)
+ "Open a new group based on the current article(s).
+This will allow you to read digests and other similar
+documents as newsgroups.
+Obeys the standard process/prefix convention."
+ (interactive "P")
+ (let* ((articles (gnus-summary-work-articles n))
+ (ogroup gnus-newsgroup-name)
+ (params (append (gnus-info-params (gnus-get-info ogroup))
+ (list (cons 'to-group ogroup))))
+ article group egroup groups vgroup)
+ (while (setq article (pop articles))
+ (setq group (format "%s-%d" gnus-newsgroup-name article))
+ (gnus-summary-remove-process-mark article)
+ (when (gnus-summary-display-article article)
+ (save-excursion
+ (nnheader-temp-write nil
+ (insert-buffer-substring gnus-original-article-buffer)
+ ;; Remove some headers that may lead nndoc to make
+ ;; the wrong guess.
+ (message-narrow-to-head)
+ (goto-char (point-min))
+ (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (widen)
+ (if (setq egroup
+ (gnus-group-read-ephemeral-group
+ group `(nndoc ,group (nndoc-address ,(current-buffer))
+ (nndoc-article-type guess))
+ t nil t))
+ (progn
+ ;; Make all postings to this group go to the parent group.
+ (nconc (gnus-info-params (gnus-get-info egroup))
+ params)
+ (push egroup groups))
+ ;; Couldn't select this doc group.
+ (gnus-error 3 "Article couldn't be entered"))))))
+ ;; Now we have selected all the documents.
+ (cond
+ ((not groups)
+ (error "None of the articles could be interpreted as documents"))
+ ((gnus-group-read-ephemeral-group
+ (setq vgroup (format
+ "nnvirtual:%s-%s" gnus-newsgroup-name
+ (format-time-string "%Y%m%dT%H%M%S" (current-time))))
+ `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
+ t
+ (cons (current-buffer) 'summary)))
+ (t
+ (error "Couldn't select virtual nndoc group")))))
+
+(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."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ ;;(goto-char (point-min))
+ (isearch-forward regexp-p)))
+
+(defun gnus-summary-search-article-forward (regexp &optional backward)
+ "Search for an article containing REGEXP forward.
+If BACKWARD, search backward instead."
+ (interactive
+ (list (read-string
+ (format "Search article %s (regexp%s): "
+ (if current-prefix-arg "backward" "forward")
+ (if gnus-last-search-regexp
+ (concat ", default " gnus-last-search-regexp)
+ "")))
+ current-prefix-arg))
+ (gnus-set-global-variables)
+ (if (string-equal regexp "")
+ (setq regexp (or gnus-last-search-regexp ""))
+ (setq gnus-last-search-regexp regexp))
+ (if (gnus-summary-search-article regexp backward)
+ (gnus-summary-show-thread)
+ (error "Search failed: \"%s\"" regexp)))
+
+(defun gnus-summary-search-article-backward (regexp)
+ "Search for an article containing REGEXP backward."
+ (interactive
+ (list (read-string
+ (format "Search article backward (regexp%s): "
+ (if gnus-last-search-regexp
+ (concat ", default " gnus-last-search-regexp)
+ "")))))
+ (gnus-summary-search-article-forward regexp 'backward))
+
+(defun gnus-summary-search-article (regexp &optional backward)
+ "Search for an article containing REGEXP.
+Optional argument BACKWARD means do search for backward.
+`gnus-select-article-hook' is not called during the search."
+ ;; We have to require this here to make sure that the following
+ ;; dynamic binding isn't shadowed by autoloading.
+ (require 'gnus-async)
+ (let ((gnus-select-article-hook nil) ;Disable hook.
+ (gnus-article-display-hook nil)
+ (gnus-mark-article-hook nil) ;Inhibit marking as read.
+ (gnus-use-article-prefetch nil)
+ (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
+ (gnus-use-trees nil) ;Inhibit updating tree buffer.
+ (sum (current-buffer))
+ (found nil)
+ point)
+ (gnus-save-hidden-threads
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (when backward
+ (forward-line -1))
+ (while (not found)
+ (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
+ (if (if backward
+ (re-search-backward regexp nil t)
+ (re-search-forward regexp nil t))
+ ;; We found the regexp.
+ (progn
+ (setq found 'found)
+ (beginning-of-line)
+ (set-window-start
+ (get-buffer-window (current-buffer))
+ (point))
+ (forward-line 1)
+ (set-buffer sum)
+ (setq point (point)))
+ ;; We didn't find it, so we go to the next article.
+ (set-buffer sum)
+ (setq found 'not)
+ (while (eq found 'not)
+ (if (not (if backward (gnus-summary-find-prev)
+ (gnus-summary-find-next)))
+ ;; No more articles.
+ (setq found t)
+ ;; Select the next article and adjust point.
+ (unless (gnus-summary-article-sparse-p
+ (gnus-summary-article-number))
+ (setq found nil)
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (widen)
+ (goto-char (if backward (point-max) (point-min))))))))
+ (gnus-message 7 ""))
+ ;; Return whether we found the regexp.
+ (when (eq found 'found)
+ (goto-char point)
+ (gnus-summary-show-thread)
+ (gnus-summary-goto-subject gnus-current-article)
+ (gnus-summary-position-point)
+ t)))
+
+(defun gnus-summary-find-matching (header regexp &optional backward unread
+ not-case-fold)
+ "Return a list of all articles that match REGEXP on HEADER.
+The search stars on the current article and goes forwards unless
+BACKWARD is non-nil. If BACKWARD is `all', do all articles.
+If UNREAD is non-nil, only unread articles will
+be taken into consideration. If NOT-CASE-FOLD, case won't be folded
+in the comparisons."
+ (let ((data (if (eq backward 'all) gnus-newsgroup-data
+ (gnus-data-find-list
+ (gnus-summary-article-number) (gnus-data-list backward))))
+ (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
+ (case-fold-search (not not-case-fold))
+ articles d)
+ (unless (fboundp (intern (concat "mail-header-" header)))
+ (error "%s is not a valid header" header))
+ (while data
+ (setq d (car data))
+ (and (or (not unread) ; We want all articles...
+ (gnus-data-unread-p d)) ; Or just unreads.
+ (vectorp (gnus-data-header d)) ; It's not a pseudo.
+ (string-match regexp (funcall func (gnus-data-header d))) ; Match.
+ (push (gnus-data-number d) articles)) ; Success!
+ (setq data (cdr data)))
+ (nreverse articles)))
+
+(defun gnus-summary-execute-command (header regexp command &optional backward)
+ "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
+If HEADER is an empty string (or nil), the match is done on the entire
+article. If BACKWARD (the prefix) is non-nil, search backward instead."
+ (interactive
+ (list (let ((completion-ignore-case t))
+ (completing-read
+ "Header name: "
+ (mapcar (lambda (string) (list string))
+ '("Number" "Subject" "From" "Lines" "Date"
+ "Message-ID" "Xref" "References" "Body"))
+ nil 'require-match))
+ (read-string "Regexp: ")
+ (read-key-sequence "Command: ")
+ current-prefix-arg))
+ (when (equal header "Body")
+ (setq header ""))
+ (gnus-set-global-variables)
+ ;; Hidden thread subtrees must be searched as well.
+ (gnus-summary-show-all-threads)
+ ;; We don't want to change current point nor window configuration.
+ (save-excursion
+ (save-window-excursion
+ (gnus-message 6 "Executing %s..." (key-description command))
+ ;; We'd like to execute COMMAND interactively so as to give arguments.
+ (gnus-execute header regexp
+ `(call-interactively ',(key-binding command))
+ backward)
+ (gnus-message 6 "Executing %s...done" (key-description command)))))
+
+(defun gnus-summary-beginning-of-article ()
+ "Scroll the article back to the beginning."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (widen)
+ (goto-char (point-min))
+ (when gnus-page-broken
+ (gnus-narrow-to-page))))
+
+(defun gnus-summary-end-of-article ()
+ "Scroll to the end of the article."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (widen)
+ (goto-char (point-max))
+ (recenter -3)
+ (when gnus-page-broken
+ (gnus-narrow-to-page))))
+
+(defun gnus-summary-print-article (&optional filename)
+ "Generate and print a PostScript image of the article buffer.
+
+If the optional argument FILENAME is nil, send the image to the printer.
+If FILENAME is a string, save the PostScript image in a file with that
+name. If FILENAME is a number, prompt the user for the name of the file
+to save in."
+ (interactive (list (ps-print-preprint current-prefix-arg)))
+ (gnus-summary-select-article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (let ((buffer (generate-new-buffer " *print*")))
+ (unwind-protect
+ (progn
+ (copy-to-buffer buffer (point-min) (point-max))
+ (set-buffer buffer)
+ (gnus-article-delete-invisible-text)
+ (run-hooks 'gnus-ps-print-hook)
+ (ps-print-buffer-with-faces filename))
+ (kill-buffer buffer)))))
+
+(defun gnus-summary-show-article (&optional arg)
+ "Force re-fetching of the current article.
+If ARG (the prefix) is non-nil, show the raw article without any
+article massaging functions being run."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (if (not arg)
+ ;; Select the article the normal way.
+ (gnus-summary-select-article nil 'force)
+ ;; Bind the article treatment functions to nil.
+ (let ((gnus-have-all-headers t)
+ gnus-article-display-hook
+ gnus-article-prepare-hook
+ gnus-break-pages
+ gnus-show-mime
+ gnus-visual)
+ (gnus-summary-select-article nil 'force)))
+ (gnus-summary-goto-subject gnus-current-article)
+ (gnus-summary-position-point))
+
+(defun gnus-summary-verbose-headers (&optional arg)
+ "Toggle permanent full header display.
+If ARG is a positive number, turn header display on.
+If ARG is a negative number, turn header display off."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (setq gnus-show-all-headers
+ (cond ((or (not (numberp arg))
+ (zerop arg))
+ (not gnus-show-all-headers))
+ ((natnump arg)
+ t)))
+ (gnus-summary-show-article))
+
+(defun gnus-summary-toggle-header (&optional arg)
+ "Show the headers if they are hidden, or hide them if they are shown.
+If ARG is a positive number, show the entire header.
+If ARG is a negative number, hide the unwanted header lines."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let* ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (hidden (text-property-any
+ (goto-char (point-min)) (search-forward "\n\n")
+ 'invisible t))
+ e)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (point-min) (1- (point))))
+ (goto-char (point-min))
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
+ (insert-buffer-substring gnus-original-article-buffer 1 e)
+ (let ((article-inhibit-hiding t))
+ (run-hooks 'gnus-article-display-hook))
+ (when (or (not hidden) (and (numberp arg) (< arg 0)))
+ (gnus-article-hide-headers)))))
+
+(defun gnus-summary-show-all-headers ()
+ "Make all header lines visible."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-article-show-all-headers))
+
+(defun gnus-summary-toggle-mime (&optional arg)
+ "Toggle MIME processing.
+If ARG is a positive number, turn MIME processing on."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (setq gnus-show-mime
+ (if (null arg) (not gnus-show-mime)
+ (> (prefix-numeric-value arg) 0)))
+ (gnus-summary-select-article t 'force))
+
+(defun gnus-summary-caesar-message (&optional arg)
+ "Caesar rotate the current article by 13.
+The numerical prefix specifies how many places to rotate each letter
+forward."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (let ((mail-header-separator ""))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (let ((start (window-start))
+ buffer-read-only)
+ (message-caesar-buffer-body arg)
+ (set-window-start (get-buffer-window (current-buffer)) start))))))
+
+(defun gnus-summary-stop-page-breaking ()
+ "Stop page breaking in the current article."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (widen)
+ (when (gnus-visual-p 'page-marker)
+ (let ((buffer-read-only nil))
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)))))
+
+(defun gnus-summary-move-article (&optional n to-newsgroup
+ select-method action)
+ "Move the current article to a different newsgroup.
+If N is a positive number, move the N next articles.
+If N is a negative number, move the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+move those articles instead.
+If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
+If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
+re-spool using this method.
+
+For this function to work, both the current newsgroup and the
+newsgroup that you want to move to have to support the `request-move'
+and `request-accept' functions."
+ (interactive "P")
+ (unless action
+ (setq action 'move))
+ (gnus-set-global-variables)
+ ;; Disable marking as read.
+ (let (gnus-mark-article-hook)
+ (save-window-excursion
+ (gnus-summary-select-article)))
+ ;; Check whether the source group supports the required functions.
+ (cond ((and (eq action 'move)
+ (not (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name)))
+ (error "The current group does not support article moving"))
+ ((and (eq action 'crosspost)
+ (not (gnus-check-backend-function
+ 'request-replace-article gnus-newsgroup-name)))
+ (error "The current group does not support article editing")))
+ (let ((articles (gnus-summary-work-articles n))
+ (prefix (gnus-group-real-prefix gnus-newsgroup-name))
+ (names '((move "Move" "Moving")
+ (copy "Copy" "Copying")
+ (crosspost "Crosspost" "Crossposting")))
+ (copy-buf (save-excursion
+ (nnheader-set-temp-buffer " *copy article*")))
+ art-group to-method new-xref article to-groups)
+ (unless (assq action names)
+ (error "Unknown action %s" action))
+ ;; Read the newsgroup name.
+ (when (and (not to-newsgroup)
+ (not select-method))
+ (setq to-newsgroup
+ (gnus-read-move-group-name
+ (cadr (assq action names))
+ (symbol-value (intern (format "gnus-current-%s-group" action)))
+ articles prefix))
+ (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
+ (setq to-method (or select-method
+ (gnus-group-name-to-method to-newsgroup)))
+ ;; Check the method we are to move this article to...
+ (unless (gnus-check-backend-function
+ 'request-accept-article (car to-method))
+ (error "%s does not support article copying" (car to-method)))
+ (unless (gnus-check-server to-method)
+ (error "Can't open server %s" (car to-method)))
+ (gnus-message 6 "%s to %s: %s..."
+ (caddr (assq action names))
+ (or (car select-method) to-newsgroup) articles)
+ (while articles
+ (setq article (pop articles))
+ (setq
+ art-group
+ (cond
+ ;; Move the article.
+ ((eq action 'move)
+ ;; Remove this article from future suppression.
+ (gnus-dup-unsuppress-article article)
+ (gnus-request-move-article
+ article ; Article to move
+ gnus-newsgroup-name ; From newsgroup
+ (nth 1 (gnus-find-method-for-group
+ gnus-newsgroup-name)) ; Server
+ (list 'gnus-request-accept-article
+ to-newsgroup (list 'quote select-method)
+ (not articles)) ; Accept form
+ (not articles))) ; Only save nov last time
+ ;; Copy the article.
+ ((eq action 'copy)
+ (save-excursion
+ (set-buffer copy-buf)
+ (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles))))
+ ;; Crosspost the article.
+ ((eq action 'crosspost)
+ (let ((xref (message-tokenize-header
+ (mail-header-xref (gnus-summary-article-header article))
+ " ")))
+ (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
+ ":" article))
+ (unless xref
+ (setq xref (list (system-name))))
+ (setq new-xref
+ (concat
+ (mapconcat 'identity
+ (delete "Xref:" (delete new-xref xref))
+ " ")
+ " " new-xref))
+ (save-excursion
+ (set-buffer copy-buf)
+ ;; First put the article in the destination group.
+ (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (when (consp (setq art-group
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles))))
+ (setq new-xref (concat new-xref " " (car art-group)
+ ":" (cdr art-group)))
+ ;; Now we have the new Xrefs header, so we insert
+ ;; it and replace the new article.
+ (nnheader-replace-header "Xref" new-xref)
+ (gnus-request-replace-article
+ (cdr art-group) to-newsgroup (current-buffer))
+ art-group))))))
+ (cond
+ ((not art-group)
+ (gnus-message 1 "Couldn't %s article %s"
+ (cadr (assq action names)) article))
+ ((and (eq art-group 'junk)
+ (eq action 'move))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (gnus-message 4 "Deleted article %s" article))
+ (t
+ (let* ((entry
+ (or
+ (gnus-gethash (car art-group) gnus-newsrc-hashtb)
+ (gnus-gethash
+ (gnus-group-prefixed-name
+ (car art-group)
+ (or select-method
+ (gnus-find-method-for-group to-newsgroup)))
+ gnus-newsrc-hashtb)))
+ (info (nth 2 entry))
+ (to-group (gnus-info-group info)))
+ ;; Update the group that has been moved to.
+ (when (and info
+ (memq action '(move copy)))
+ (unless (member to-group to-groups)
+ (push to-group to-groups))
+
+ (unless (memq article gnus-newsgroup-unreads)
+ (gnus-info-set-read
+ info (gnus-add-to-range (gnus-info-read info)
+ (list (cdr art-group)))))
+
+ ;; Copy any marks over to the new group.
+ (let ((marks gnus-article-mark-lists)
+ (to-article (cdr art-group)))
+
+ ;; See whether the article is to be put in the cache.
+ (when gnus-use-cache
+ (gnus-cache-possibly-enter-article
+ to-group to-article
+ (let ((header (copy-sequence
+ (gnus-summary-article-header article))))
+ (mail-header-set-number header to-article)
+ header)
+ (memq article gnus-newsgroup-marked)
+ (memq article gnus-newsgroup-dormant)
+ (memq article gnus-newsgroup-unreads)))
+
+ (when (and (equal to-group gnus-newsgroup-name)
+ (not (memq article gnus-newsgroup-unreads)))
+ ;; Mark this article as read in this group.
+ (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
+ (setcdr (gnus-active to-group) to-article)
+ (setcdr gnus-newsgroup-active to-article))
+
+ (while marks
+ (when (memq article (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))
+ ;; If the other group is the same as this group,
+ ;; then we have to add the mark to the list.
+ (when (equal to-group gnus-newsgroup-name)
+ (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+ (cons to-article
+ (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))))
+ ;; Copy the marks to other group.
+ (gnus-add-marked-articles
+ to-group (cdar marks) (list to-article) info))
+ (setq marks (cdr marks)))
+
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (gnus-get-info to-group))
+ ")"))))
+
+ ;; Update the Xref header in this article to point to
+ ;; the new crossposted article we have just created.
+ (when (eq action 'crosspost)
+ (save-excursion
+ (set-buffer copy-buf)
+ (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (nnheader-replace-header "Xref" new-xref)
+ (gnus-request-replace-article
+ article gnus-newsgroup-name (current-buffer)))))
+
+ (gnus-summary-goto-subject article)
+ (when (eq action 'move)
+ (gnus-summary-mark-article article gnus-canceled-mark))))
+ (gnus-summary-remove-process-mark article))
+ ;; Re-activate all groups that have been moved to.
+ (while to-groups
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (when (gnus-group-goto-group (car to-groups) t)
+ (gnus-group-get-new-news-this-group 1 t))
+ (pop to-groups)))
+
+ (gnus-kill-buffer copy-buf)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)))
+
+(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
+ "Move the current article to a different newsgroup.
+If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
+If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
+re-spool using this method."
+ (interactive "P")
+ (gnus-summary-move-article n to-newsgroup select-method 'copy))
+
+(defun gnus-summary-crosspost-article (&optional n)
+ "Crosspost the current article to some other group."
+ (interactive "P")
+ (gnus-summary-move-article n nil nil 'crosspost))
+
+(defcustom gnus-summary-respool-default-method nil
+ "Default method for respooling an article.
+If nil, use to the current newsgroup method."
+ :type `(choice (gnus-select-method :value (nnml ""))
+ (const nil))
+ :group 'gnus-summary-mail)
+
+(defun gnus-summary-respool-article (&optional n method)
+ "Respool the current article.
+The article will be squeezed through the mail spooling process again,
+which means that it will be put in some mail newsgroup or other
+depending on `nnmail-split-methods'.
+If N is a positive number, respool the N next articles.
+If N is a negative number, respool the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+respool those articles instead.
+
+Respooling can be done both from mail groups and \"real\" newsgroups.
+In the former case, the articles in question will be moved from the
+current group into whatever groups they are destined to. In the
+latter case, they will be copied into the relevant groups."
+ (interactive
+ (list current-prefix-arg
+ (let* ((methods (gnus-methods-using 'respool))
+ (methname
+ (symbol-name (or gnus-summary-respool-default-method
+ (car (gnus-find-method-for-group
+ gnus-newsgroup-name)))))
+ (method
+ (gnus-completing-read
+ methname "What backend do you want to use when respooling?"
+ methods nil t nil 'gnus-mail-method-history))
+ ms)
+ (cond
+ ((zerop (length (setq ms (gnus-servers-using-backend
+ (intern method)))))
+ (list (intern method) ""))
+ ((= 1 (length ms))
+ (car ms))
+ (t
+ (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
+ (cdr (assoc (completing-read "Server name: " ms-alist nil t)
+ ms-alist))))))))
+ (gnus-set-global-variables)
+ (unless method
+ (error "No method given for respooling"))
+ (if (assoc (symbol-name
+ (car (gnus-find-method-for-group gnus-newsgroup-name)))
+ (gnus-methods-using 'respool))
+ (gnus-summary-move-article n nil method)
+ (gnus-summary-copy-article n nil method)))
+
+(defun gnus-summary-import-article (file)
+ "Import a random file into a mail newsgroup."
+ (interactive "fImport file: ")
+ (gnus-set-global-variables)
+ (let ((group gnus-newsgroup-name)
+ (now (current-time))
+ atts lines)
+ (unless (gnus-check-backend-function 'request-accept-article group)
+ (error "%s does not support article importing" group))
+ (or (file-readable-p file)
+ (not (file-regular-p file))
+ (error "Can't read %s" file))
+ (save-excursion
+ (set-buffer (get-buffer-create " *import file*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (unless (nnheader-article-p)
+ ;; This doesn't look like an article, so we fudge some headers.
+ (setq atts (file-attributes file)
+ lines (count-lines (point-min) (point-max)))
+ (insert "From: " (read-string "From: ") "\n"
+ "Subject: " (read-string "Subject: ") "\n"
+ "Date: " (timezone-make-date-arpa-standard
+ (current-time-string (nth 5 atts))
+ (current-time-zone now)
+ (current-time-zone now))
+ "\n"
+ "Message-ID: " (message-make-message-id) "\n"
+ "Lines: " (int-to-string lines) "\n"
+ "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
+ (gnus-request-accept-article group nil t)
+ (kill-buffer (current-buffer)))))
+
+(defun gnus-summary-article-posted-p ()
+ "Say whether the current (mail) article is available from `gnus-select-method' as well.
+This will be the case if the article has both been mailed and posted."
+ (interactive)
+ (let ((id (mail-header-references (gnus-summary-article-header)))
+ (gnus-override-method
+ (or gnus-refer-article-method gnus-select-method)))
+ (if (gnus-request-head id "")
+ (gnus-message 2 "The current message was found on %s"
+ gnus-override-method)
+ (gnus-message 2 "The current message couldn't be found on %s"
+ gnus-override-method)
+ nil)))
+
+(defun gnus-summary-expire-articles (&optional now)
+ "Expire all articles that are marked as expirable in the current group."
+ (interactive)
+ (gnus-set-global-variables)
+ (when (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)
+ ;; This backend supports expiry.
+ (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
+ (expirable (if total
+ (progn
+ ;; We need to update the info for
+ ;; this group for `gnus-list-of-read-articles'
+ ;; to give us the right answer.
+ (run-hooks 'gnus-exit-group-hook)
+ (gnus-summary-update-info)
+ (gnus-list-of-read-articles gnus-newsgroup-name))
+ (setq gnus-newsgroup-expirable
+ (sort gnus-newsgroup-expirable '<))))
+ (expiry-wait (if now 'immediate
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'expiry-wait)))
+ es)
+ (when expirable
+ ;; There are expirable articles in this group, so we run them
+ ;; through the expiry process.
+ (gnus-message 6 "Expiring articles...")
+ ;; The list of articles that weren't expired is returned.
+ (if expiry-wait
+ (let ((nnmail-expiry-wait-function nil)
+ (nnmail-expiry-wait expiry-wait))
+ (setq es (gnus-request-expire-articles
+ expirable gnus-newsgroup-name)))
+ (setq es (gnus-request-expire-articles
+ expirable gnus-newsgroup-name)))
+ (unless total
+ (setq gnus-newsgroup-expirable es))
+ ;; We go through the old list of expirable, and mark all
+ ;; really expired articles as nonexistent.
+ (unless (eq es expirable) ;If nothing was expired, we don't mark.
+ (let ((gnus-use-cache nil))
+ (while expirable
+ (unless (memq (car expirable) es)
+ (when (gnus-data-find (car expirable))
+ (gnus-summary-mark-article
+ (car expirable) gnus-canceled-mark)))
+ (setq expirable (cdr expirable)))))
+ (gnus-message 6 "Expiring articles...done")))))
+
+(defun gnus-summary-expire-articles-now ()
+ "Expunge all expirable articles in the current group.
+This means that *all* articles that are marked as expirable will be
+deleted forever, right now."
+ (interactive)
+ (gnus-set-global-variables)
+ (or gnus-expert-user
+ (gnus-yes-or-no-p
+ "Are you really, really, really sure you want to delete all these messages? ")
+ (error "Phew!"))
+ (gnus-summary-expire-articles t))
+
+;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
+(defun gnus-summary-delete-article (&optional n)
+ "Delete the N next (mail) articles.
+This command actually deletes articles. This is not a marking
+command. The article will disappear forever from your life, never to
+return.
+If N is negative, delete backwards.
+If N is nil and articles have been marked with the process mark,
+delete these instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (unless (gnus-check-backend-function 'request-expire-articles
+ gnus-newsgroup-name)
+ (error "The current newsgroup does not support article deletion"))
+ ;; Compute the list of articles to delete.
+ (let ((articles (gnus-summary-work-articles n))
+ not-deleted)
+ (if (and gnus-novice-user
+ (not (gnus-yes-or-no-p
+ (format "Do you really want to delete %s forever? "
+ (if (> (length articles) 1)
+ (format "these %s articles" (length articles))
+ "this article")))))
+ ()
+ ;; Delete the articles.
+ (setq not-deleted (gnus-request-expire-articles
+ articles gnus-newsgroup-name 'force))
+ (while articles
+ (gnus-summary-remove-process-mark (car articles))
+ ;; The backend might not have been able to delete the article
+ ;; after all.
+ (unless (memq (car articles) not-deleted)
+ (gnus-summary-mark-article (car articles) gnus-canceled-mark))
+ (setq articles (cdr articles)))
+ (when not-deleted
+ (gnus-message 4 "Couldn't delete articles %s" not-deleted)))
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ not-deleted))
+
+(defun gnus-summary-edit-article (&optional force)
+ "Edit the current article.
+This will have permanent effect only in mail groups.
+If FORCE is non-nil, allow editing of articles even in read-only
+groups."
+ (interactive "P")
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-set-global-variables)
+ (when (and (not force)
+ (gnus-group-read-only-p))
+ (error "The current newsgroup does not support article editing"))
+ ;; Select article if needed.
+ (unless (eq (gnus-summary-article-number)
+ gnus-current-article)
+ (gnus-summary-select-article t))
+ (gnus-article-date-original)
+ (gnus-article-edit-article
+ `(lambda (no-highlight)
+ (gnus-summary-edit-article-done
+ ,(or (mail-header-references gnus-current-headers) "")
+ ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))
+
+(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
+
+(defun gnus-summary-edit-article-done (&optional references read-only buffer
+ no-highlight)
+ "Make edits to the current article permanent."
+ (interactive)
+ ;; Replace the article.
+ (if (and (not read-only)
+ (not (gnus-request-replace-article
+ (cdr gnus-article-current) (car gnus-article-current)
+ (current-buffer))))
+ (error "Couldn't replace article")
+ ;; Update the summary buffer.
+ (if (and references
+ (equal (message-tokenize-header references " ")
+ (message-tokenize-header
+ (or (message-fetch-field "references") "") " ")))
+ ;; We only have to update this line.
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((head (buffer-string))
+ header)
+ (nnheader-temp-write nil
+ (insert (format "211 %d Article retrieved.\n"
+ (cdr gnus-article-current)))
+ (insert head)
+ (insert ".\n")
+ (let ((nntp-server-buffer (current-buffer)))
+ (setq header (car (gnus-get-newsgroup-headers
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-dependencies)
+ t))))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-data-set-header
+ (gnus-data-find (cdr gnus-article-current))
+ header)
+ (gnus-summary-update-article-line
+ (cdr gnus-article-current) header))))))
+ ;; Update threads.
+ (set-buffer (or buffer gnus-summary-buffer))
+ (gnus-summary-update-article (cdr gnus-article-current)))
+ ;; Prettify the article buffer again.
+ (unless no-highlight
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (run-hooks 'gnus-article-display-hook)
+ (set-buffer gnus-original-article-buffer)
+ (gnus-request-article
+ (cdr gnus-article-current)
+ (car gnus-article-current) (current-buffer))))
+ ;; Prettify the summary buffer line.
+ (when (gnus-visual-p 'summary-highlight 'highlight)
+ (run-hooks 'gnus-visual-mark-article-hook))))
+
+(defun gnus-summary-edit-wash (key)
+ "Perform editing command in the article buffer."
+ (interactive
+ (list
+ (progn
+ (message "%s" (concat (this-command-keys) "- "))
+ (read-char))))
+ (message "")
+ (gnus-summary-edit-article)
+ (execute-kbd-macro (concat (this-command-keys) key))
+ (gnus-article-edit-done))
+
+;;; Respooling
+
+(defun gnus-summary-respool-query (&optional silent)
+ "Query where the respool algorithm would put this article."
+ (interactive)
+ (gnus-set-global-variables)
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((groups (nnmail-article-group 'identity)))
+ (unless silent
+ (if groups
+ (message "This message would go to %s"
+ (mapconcat 'car groups ", "))
+ (message "This message would go to no groups"))
+ groups))))))
+
+;; Summary marking commands.
+
+(defun gnus-summary-kill-same-subject-and-select (&optional unmark)
+ "Mark articles which has the same subject as read, and then select the next.
+If UNMARK is positive, remove any kind of mark.
+If UNMARK is negative, tick articles."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (when unmark
+ (setq unmark (prefix-numeric-value unmark)))
+ (let ((count
+ (gnus-summary-mark-same-subject
+ (gnus-summary-article-subject) unmark)))
+ ;; Select next unread article. If auto-select-same mode, should
+ ;; select the first unread article.
+ (gnus-summary-next-article t (and gnus-auto-select-same
+ (gnus-summary-article-subject)))
+ (gnus-message 7 "%d article%s marked as %s"
+ count (if (= count 1) " is" "s are")
+ (if unmark "unread" "read"))))
+
+(defun gnus-summary-kill-same-subject (&optional unmark)
+ "Mark articles which has the same subject as read.
+If UNMARK is positive, remove any kind of mark.
+If UNMARK is negative, tick articles."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (when unmark
+ (setq unmark (prefix-numeric-value unmark)))
+ (let ((count
+ (gnus-summary-mark-same-subject
+ (gnus-summary-article-subject) unmark)))
+ ;; If marked as read, go to next unread subject.
+ (when (null unmark)
+ ;; Go to next unread subject.
+ (gnus-summary-next-subject 1 t))
+ (gnus-message 7 "%d articles are marked as %s"
+ count (if unmark "unread" "read"))))
+
+(defun gnus-summary-mark-same-subject (subject &optional unmark)
+ "Mark articles with same SUBJECT as read, and return marked number.
+If optional argument UNMARK is positive, remove any kinds of marks.
+If optional argument UNMARK is negative, mark articles as unread instead."
+ (let ((count 1))
+ (save-excursion
+ (cond
+ ((null unmark) ; Mark as read.
+ (while (and
+ (progn
+ (gnus-summary-mark-article-as-read gnus-killed-mark)
+ (gnus-summary-show-thread) t)
+ (gnus-summary-find-subject subject))
+ (setq count (1+ count))))
+ ((> unmark 0) ; Tick.
+ (while (and
+ (progn
+ (gnus-summary-mark-article-as-unread gnus-ticked-mark)
+ (gnus-summary-show-thread) t)
+ (gnus-summary-find-subject subject))
+ (setq count (1+ count))))
+ (t ; Mark as unread.
+ (while (and
+ (progn
+ (gnus-summary-mark-article-as-unread gnus-unread-mark)
+ (gnus-summary-show-thread) t)
+ (gnus-summary-find-subject subject))
+ (setq count (1+ count)))))
+ (gnus-set-mode-line 'summary)
+ ;; Return the number of marked articles.
+ count)))
+
+(defun gnus-summary-mark-as-processable (n &optional unmark)
+ "Set the process mark on the next N articles.
+If N is negative, mark backward instead. If UNMARK is non-nil, remove
+the process mark instead. The difference between N and the actual
+number of articles marked is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (while (and
+ (> n 0)
+ (if unmark
+ (gnus-summary-remove-process-mark
+ (gnus-summary-article-number))
+ (gnus-summary-set-process-mark (gnus-summary-article-number)))
+ (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more articles"))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ n))
+
+(defun gnus-summary-unmark-as-processable (n)
+ "Remove the process mark from the next N articles.
+If N is negative, unmark backward instead. The difference between N and
+the actual number of articles unmarked is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-summary-mark-as-processable n t))
+
+(defun gnus-summary-unmark-all-processable ()
+ "Remove the process mark from all articles."
+ (interactive)
+ (gnus-set-global-variables)
+ (save-excursion
+ (while gnus-newsgroup-processable
+ (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
+ (gnus-summary-position-point))
+
+(defun gnus-summary-mark-as-expirable (n)
+ "Mark N articles forward as expirable.
+If N is negative, mark backward instead. The difference between N and
+the actual number of articles marked is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-summary-mark-forward n gnus-expirable-mark))
+
+(defun gnus-summary-mark-article-as-replied (article)
+ "Mark ARTICLE replied and update the summary line."
+ (push article gnus-newsgroup-replied)
+ (let ((buffer-read-only nil))
+ (when (gnus-summary-goto-subject article)
+ (gnus-summary-update-secondary-mark article))))
+
+(defun gnus-summary-set-bookmark (article)
+ "Set a bookmark in current article."
+ (interactive (gnus-summary-article-number))
+ (gnus-set-global-variables)
+ (when (or (not (get-buffer gnus-article-buffer))
+ (not gnus-current-article)
+ (not gnus-article-current)
+ (not (equal gnus-newsgroup-name (car gnus-article-current))))
+ (error "No current article selected"))
+ ;; Remove old bookmark, if one exists.
+ (let ((old (assq article gnus-newsgroup-bookmarks)))
+ (when old
+ (setq gnus-newsgroup-bookmarks
+ (delq old gnus-newsgroup-bookmarks))))
+ ;; Set the new bookmark, which is on the form
+ ;; (article-number . line-number-in-body).
+ (push
+ (cons article
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (count-lines
+ (min (point)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (point)))
+ (point))))
+ gnus-newsgroup-bookmarks)
+ (gnus-message 6 "A bookmark has been added to the current article."))
+
+(defun gnus-summary-remove-bookmark (article)
+ "Remove the bookmark from the current article."
+ (interactive (gnus-summary-article-number))
+ (gnus-set-global-variables)
+ ;; Remove old bookmark, if one exists.
+ (let ((old (assq article gnus-newsgroup-bookmarks)))
+ (if old
+ (progn
+ (setq gnus-newsgroup-bookmarks
+ (delq old gnus-newsgroup-bookmarks))
+ (gnus-message 6 "Removed bookmark."))
+ (gnus-message 6 "No bookmark in current article."))))
+
+;; Suggested by Daniel Quinlan <quinlan@best.com>.
+(defun gnus-summary-mark-as-dormant (n)
+ "Mark N articles forward as dormant.
+If N is negative, mark backward instead. The difference between N and
+the actual number of articles marked is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-summary-mark-forward n gnus-dormant-mark))
+
+(defun gnus-summary-set-process-mark (article)
+ "Set the process mark on ARTICLE and update the summary line."
+ (setq gnus-newsgroup-processable
+ (cons article
+ (delq article gnus-newsgroup-processable)))
+ (when (gnus-summary-goto-subject article)
+ (gnus-summary-show-thread)
+ (gnus-summary-update-secondary-mark article)))
+
+(defun gnus-summary-remove-process-mark (article)
+ "Remove the process mark from ARTICLE and update the summary line."
+ (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
+ (when (gnus-summary-goto-subject article)
+ (gnus-summary-show-thread)
+ (gnus-summary-update-secondary-mark article)))
+
+(defun gnus-summary-set-saved-mark (article)
+ "Set the process mark on ARTICLE and update the summary line."
+ (push article gnus-newsgroup-saved)
+ (when (gnus-summary-goto-subject article)
+ (gnus-summary-update-secondary-mark article)))
+
+(defun gnus-summary-mark-forward (n &optional mark no-expire)
+ "Mark N articles as read forwards.
+If N is negative, mark backwards instead. Mark with MARK, ?r by default.
+The difference between N and the actual number of articles marked is
+returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (let ((backward (< n 0))
+ (gnus-summary-goto-unread
+ (and gnus-summary-goto-unread
+ (not (eq gnus-summary-goto-unread 'never))
+ (not (memq mark (list gnus-unread-mark
+ gnus-ticked-mark gnus-dormant-mark)))))
+ (n (abs n))
+ (mark (or mark gnus-del-mark)))
+ (while (and (> n 0)
+ (gnus-summary-mark-article nil mark no-expire)
+ (zerop (gnus-summary-next-subject
+ (if backward -1 1)
+ (and gnus-summary-goto-unread
+ (not (eq gnus-summary-goto-unread 'never)))
+ t)))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ n))
+
+(defun gnus-summary-mark-article-as-read (mark)
+ "Mark the current article quickly as read with MARK."
+ (let ((article (gnus-summary-article-number)))
+ (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
+ (push (cons article mark) gnus-newsgroup-reads)
+ ;; Possibly remove from cache, if that is used.
+ (when gnus-use-cache
+ (gnus-cache-enter-remove-article article))
+ ;; Allow the backend to change the mark.
+ (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
+ ;; Check for auto-expiry.
+ (when (and gnus-newsgroup-auto-expire
+ (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
+ (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
+ (= mark gnus-ancient-mark)
+ (= mark gnus-read-mark) (= mark gnus-souped-mark)
+ (= mark gnus-duplicate-mark)))
+ (setq mark gnus-expirable-mark)
+ (push article gnus-newsgroup-expirable))
+ ;; Set the mark in the buffer.
+ (gnus-summary-update-mark mark 'unread)
+ t))
+
+(defun gnus-summary-mark-article-as-unread (mark)
+ "Mark the current article quickly as unread with MARK."
+ (let ((article (gnus-summary-article-number)))
+ (if (< article 0)
+ (gnus-error 1 "Unmarkable article")
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
+ (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
+ (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
+ (cond ((= mark gnus-ticked-mark)
+ (push article gnus-newsgroup-marked))
+ ((= mark gnus-dormant-mark)
+ (push article gnus-newsgroup-dormant))
+ (t
+ (push article gnus-newsgroup-unreads)))
+ (setq gnus-newsgroup-reads
+ (delq (assq article gnus-newsgroup-reads)
+ gnus-newsgroup-reads))
+
+ ;; See whether the article is to be put in the cache.
+ (and gnus-use-cache
+ (vectorp (gnus-summary-article-header article))
+ (save-excursion
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
+
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread))
+ t))
+
+(defun gnus-summary-mark-article (&optional article mark no-expire)
+ "Mark ARTICLE with MARK. MARK can be any character.
+Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
+`??' (dormant) and `?E' (expirable).
+If MARK is nil, then the default character `?D' is used.
+If ARTICLE is nil, then the article on the current line will be
+marked."
+ ;; The mark might be a string.
+ (when (stringp mark)
+ (setq mark (aref mark 0)))
+ ;; If no mark is given, then we check auto-expiring.
+ (and (not no-expire)
+ gnus-newsgroup-auto-expire
+ (or (not mark)
+ (and (gnus-characterp mark)
+ (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
+ (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
+ (= mark gnus-read-mark) (= mark gnus-souped-mark)
+ (= mark gnus-duplicate-mark))))
+ (setq mark gnus-expirable-mark))
+ (let* ((mark (or mark gnus-del-mark))
+ (article (or article (gnus-summary-article-number))))
+ (unless article
+ (error "No article on current line"))
+ (if (or (= mark gnus-unread-mark)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark))
+ (gnus-mark-article-as-unread article mark)
+ (gnus-mark-article-as-read article mark))
+
+ ;; See whether the article is to be put in the cache.
+ (and gnus-use-cache
+ (not (= mark gnus-canceled-mark))
+ (vectorp (gnus-summary-article-header article))
+ (save-excursion
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
+
+ (when (gnus-summary-goto-subject article nil t)
+ (let ((buffer-read-only nil))
+ (gnus-summary-show-thread)
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread)
+ t))))
+
+(defun gnus-summary-update-secondary-mark (article)
+ "Update the secondary (read, process, cache) mark."
+ (gnus-summary-update-mark
+ (cond ((memq article gnus-newsgroup-processable)
+ gnus-process-mark)
+ ((memq article gnus-newsgroup-cached)
+ gnus-cached-mark)
+ ((memq article gnus-newsgroup-replied)
+ gnus-replied-mark)
+ ((memq article gnus-newsgroup-saved)
+ gnus-saved-mark)
+ (t gnus-unread-mark))
+ 'replied)
+ (when (gnus-visual-p 'summary-highlight 'highlight)
+ (run-hooks 'gnus-summary-update-hook))
+ t)
+
+(defun gnus-summary-update-mark (mark type)
+ (let ((forward (cdr (assq type gnus-summary-mark-positions)))
+ (buffer-read-only nil))
+ (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
+ (when (looking-at "\r")
+ (incf forward))
+ (when (and forward
+ (<= (+ forward (point)) (point-max)))
+ ;; Go to the right position on the line.
+ (goto-char (+ forward (point)))
+ ;; Replace the old mark with the new mark.
+ (subst-char-in-region (point) (1+ (point)) (following-char) mark)
+ ;; Optionally update the marks by some user rule.
+ (when (eq type 'unread)
+ (gnus-data-set-mark
+ (gnus-data-find (gnus-summary-article-number)) mark)
+ (gnus-summary-update-line (eq mark gnus-unread-mark))))))
+
+(defun gnus-mark-article-as-read (article &optional mark)
+ "Enter ARTICLE in the pertinent lists and remove it from others."
+ ;; Make the article expirable.
+ (let ((mark (or mark gnus-del-mark)))
+ (if (= mark gnus-expirable-mark)
+ (push article gnus-newsgroup-expirable)
+ (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
+ ;; Remove from unread and marked lists.
+ (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
+ (push (cons article mark) gnus-newsgroup-reads)
+ ;; Possibly remove from cache, if that is used.
+ (when gnus-use-cache
+ (gnus-cache-enter-remove-article article))))
+
+(defun gnus-mark-article-as-unread (article &optional mark)
+ "Enter ARTICLE in the pertinent lists and remove it from others."
+ (let ((mark (or mark gnus-ticked-mark)))
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
+ gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
+ gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
+ gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
+
+ ;; Unsuppress duplicates?
+ (when gnus-suppress-duplicates
+ (gnus-dup-unsuppress-article article))
+
+ (cond ((= mark gnus-ticked-mark)
+ (push article gnus-newsgroup-marked))
+ ((= mark gnus-dormant-mark)
+ (push article gnus-newsgroup-dormant))
+ (t
+ (push article gnus-newsgroup-unreads)))
+ (setq gnus-newsgroup-reads
+ (delq (assq article gnus-newsgroup-reads)
+ gnus-newsgroup-reads))))
+
+(defalias 'gnus-summary-mark-as-unread-forward
+ 'gnus-summary-tick-article-forward)
+(make-obsolete 'gnus-summary-mark-as-unread-forward
+ 'gnus-summary-tick-article-forward)
+(defun gnus-summary-tick-article-forward (n)
+ "Tick N articles forwards.
+If N is negative, tick backwards instead.
+The difference between N and the number of articles ticked is returned."
+ (interactive "p")
+ (gnus-summary-mark-forward n gnus-ticked-mark))
+
+(defalias 'gnus-summary-mark-as-unread-backward
+ 'gnus-summary-tick-article-backward)
+(make-obsolete 'gnus-summary-mark-as-unread-backward
+ 'gnus-summary-tick-article-backward)
+(defun gnus-summary-tick-article-backward (n)
+ "Tick N articles backwards.
+The difference between N and the number of articles ticked is returned."
+ (interactive "p")
+ (gnus-summary-mark-forward (- n) gnus-ticked-mark))
+
+(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
+(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
+(defun gnus-summary-tick-article (&optional article clear-mark)
+ "Mark current article as unread.
+Optional 1st argument ARTICLE specifies article number to be marked as unread.
+Optional 2nd argument CLEAR-MARK remove any kinds of mark."
+ (interactive)
+ (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
+ gnus-ticked-mark)))
+
+(defun gnus-summary-mark-as-read-forward (n)
+ "Mark N articles as read forwards.
+If N is negative, mark backwards instead.
+The difference between N and the actual number of articles marked is
+returned."
+ (interactive "p")
+ (gnus-summary-mark-forward n gnus-del-mark t))
+
+(defun gnus-summary-mark-as-read-backward (n)
+ "Mark the N articles as read backwards.
+The difference between N and the actual number of articles marked is
+returned."
+ (interactive "p")
+ (gnus-summary-mark-forward (- n) gnus-del-mark t))
+
+(defun gnus-summary-mark-as-read (&optional article mark)
+ "Mark current article as read.
+ARTICLE specifies the article to be marked as read.
+MARK specifies a string to be inserted at the beginning of the line."
+ (gnus-summary-mark-article article mark))
+
+(defun gnus-summary-clear-mark-forward (n)
+ "Clear marks from N articles forward.
+If N is negative, clear backward instead.
+The difference between N and the number of marks cleared is returned."
+ (interactive "p")
+ (gnus-summary-mark-forward n gnus-unread-mark))
+
+(defun gnus-summary-clear-mark-backward (n)
+ "Clear marks from N articles backward.
+The difference between N and the number of marks cleared is returned."
+ (interactive "p")
+ (gnus-summary-mark-forward (- n) gnus-unread-mark))
+
+(defun gnus-summary-mark-unread-as-read ()
+ "Intended to be used by `gnus-summary-mark-article-hook'."
+ (when (memq gnus-current-article gnus-newsgroup-unreads)
+ (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
+
+(defun gnus-summary-mark-read-and-unread-as-read ()
+ "Intended to be used by `gnus-summary-mark-article-hook'."
+ (let ((mark (gnus-summary-article-mark)))
+ (when (or (gnus-unread-mark-p mark)
+ (gnus-read-mark-p mark))
+ (gnus-summary-mark-article gnus-current-article gnus-read-mark))))
+
+(defun gnus-summary-mark-region-as-read (point mark all)
+ "Mark all unread articles between point and mark as read.
+If given a prefix, mark all articles between point and mark as read,
+even ticked and dormant ones."
+ (interactive "r\nP")
+ (save-excursion
+ (let (article)
+ (goto-char point)
+ (beginning-of-line)
+ (while (and
+ (< (point) mark)
+ (progn
+ (when (or all
+ (memq (setq article (gnus-summary-article-number))
+ gnus-newsgroup-unreads))
+ (gnus-summary-mark-article article gnus-del-mark))
+ t)
+ (gnus-summary-find-next))))))
+
+(defun gnus-summary-mark-below (score mark)
+ "Mark articles with score less than SCORE with MARK."
+ (interactive "P\ncMark: ")
+ (gnus-set-global-variables)
+ (setq score (if score
+ (prefix-numeric-value score)
+ (or gnus-summary-default-score 0)))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (goto-char (point-min))
+ (while
+ (progn
+ (and (< (gnus-summary-article-score) score)
+ (gnus-summary-mark-article nil mark))
+ (gnus-summary-find-next)))))
+
+(defun gnus-summary-kill-below (&optional score)
+ "Mark articles with score below SCORE as read."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-mark-below score gnus-killed-mark))
+
+(defun gnus-summary-clear-above (&optional score)
+ "Clear all marks from articles with score above SCORE."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-mark-above score gnus-unread-mark))
+
+(defun gnus-summary-tick-above (&optional score)
+ "Tick all articles with score above SCORE."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-mark-above score gnus-ticked-mark))
+
+(defun gnus-summary-mark-above (score mark)
+ "Mark articles with score over SCORE with MARK."
+ (interactive "P\ncMark: ")
+ (gnus-set-global-variables)
+ (setq score (if score
+ (prefix-numeric-value score)
+ (or gnus-summary-default-score 0)))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (goto-char (point-min))
+ (while (and (progn
+ (when (> (gnus-summary-article-score) score)
+ (gnus-summary-mark-article nil mark))
+ t)
+ (gnus-summary-find-next)))))
+
+;; Suggested by Daniel Quinlan <quinlan@best.com>.
+(defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
+(defun gnus-summary-limit-include-expunged (&optional no-error)
+ "Display all the hidden articles that were expunged for low scores."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((buffer-read-only nil))
+ (let ((scored gnus-newsgroup-scored)
+ headers h)
+ (while scored
+ (unless (gnus-summary-goto-subject (caar scored))
+ (and (setq h (gnus-summary-article-header (caar scored)))
+ (< (cdar scored) gnus-summary-expunge-below)
+ (push h headers)))
+ (setq scored (cdr scored)))
+ (if (not headers)
+ (when (not no-error)
+ (error "No expunged articles hidden"))
+ (goto-char (point-min))
+ (gnus-summary-prepare-unthreaded (nreverse headers))
+ (goto-char (point-min))
+ (gnus-summary-position-point)
+ t))))
+
+(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
+ "Mark all unread articles in this newsgroup as read.
+If prefix argument ALL is non-nil, ticked and dormant articles will
+also be marked as read.
+If QUIETLY is non-nil, no questions will be asked.
+If TO-HERE is non-nil, it should be a point in the buffer. All
+articles before this point will be marked as read.
+Note that this function will only catch up the unread article
+in the current summary buffer limitation.
+The number of articles marked as read is returned."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (prog1
+ (save-excursion
+ (when (or quietly
+ (not gnus-interactive-catchup) ;Without confirmation?
+ gnus-expert-user
+ (gnus-y-or-n-p
+ (if all
+ "Mark absolutely all articles as read? "
+ "Mark all unread articles as read? ")))
+ (if (and not-mark
+ (not gnus-newsgroup-adaptive)
+ (not gnus-newsgroup-auto-expire)
+ (not gnus-suppress-duplicates)
+ (or (not gnus-use-cache)
+ (eq gnus-use-cache 'passive)))
+ (progn
+ (when all
+ (setq gnus-newsgroup-marked nil
+ gnus-newsgroup-dormant nil))
+ (setq gnus-newsgroup-unreads nil))
+ ;; We actually mark all articles as canceled, which we
+ ;; have to do when using auto-expiry or adaptive scoring.
+ (gnus-summary-show-all-threads)
+ (when (gnus-summary-first-subject (not all))
+ (while (and
+ (if to-here (< (point) to-here) t)
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)
+ (gnus-summary-find-next (not all)))))
+ (gnus-set-mode-line 'summary))
+ t))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-catchup-to-here (&optional all)
+ "Mark all unticked articles before the current one as read.
+If ALL is non-nil, also mark ticked and dormant articles as read."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (save-excursion
+ (gnus-save-hidden-threads
+ (let ((beg (point)))
+ ;; We check that there are unread articles.
+ (when (or all (gnus-summary-find-prev))
+ (gnus-summary-catchup all t beg)))))
+ (gnus-summary-position-point))
+
+(defun gnus-summary-catchup-all (&optional quietly)
+ "Mark all articles in this newsgroup as read."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-catchup t quietly))
+
+(defun gnus-summary-catchup-and-exit (&optional all quietly)
+ "Mark all articles not marked as unread in this newsgroup as read, then exit.
+If prefix argument ALL is non-nil, all articles are marked as read."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (when (gnus-summary-catchup all quietly nil 'fast)
+ ;; Select next newsgroup or exit.
+ (if (eq gnus-auto-select-next 'quietly)
+ (gnus-summary-next-group nil)
+ (gnus-summary-exit))))
+
+(defun gnus-summary-catchup-all-and-exit (&optional quietly)
+ "Mark all articles in this newsgroup as read, and then exit."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-catchup-and-exit t quietly))
+
+;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
+(defun gnus-summary-catchup-and-goto-next-group (&optional all)
+ "Mark all articles in this group as read and select the next group.
+If given a prefix, mark all articles, unread as well as ticked, as
+read."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (save-excursion
+ (gnus-summary-catchup all))
+ (gnus-summary-next-article t nil nil t))
+
+;; Thread-based commands.
+
+(defun gnus-summary-articles-in-thread (&optional article)
+ "Return a list of all articles in the current thread.
+If ARTICLE is non-nil, return all articles in the thread that starts
+with that article."
+ (let* ((article (or article (gnus-summary-article-number)))
+ (data (gnus-data-find-list article))
+ (top-level (gnus-data-level (car data)))
+ (top-subject
+ (cond ((null gnus-thread-operation-ignore-subject)
+ (gnus-simplify-subject-re
+ (mail-header-subject (gnus-data-header (car data)))))
+ ((eq gnus-thread-operation-ignore-subject 'fuzzy)
+ (gnus-simplify-subject-fuzzy
+ (mail-header-subject (gnus-data-header (car data)))))
+ (t nil)))
+ (end-point (save-excursion
+ (if (gnus-summary-go-to-next-thread)
+ (point) (point-max))))
+ articles)
+ (while (and data
+ (< (gnus-data-pos (car data)) end-point))
+ (when (or (not top-subject)
+ (string= top-subject
+ (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
+ (gnus-simplify-subject-fuzzy
+ (mail-header-subject
+ (gnus-data-header (car data))))
+ (gnus-simplify-subject-re
+ (mail-header-subject
+ (gnus-data-header (car data)))))))
+ (push (gnus-data-number (car data)) articles))
+ (unless (and (setq data (cdr data))
+ (> (gnus-data-level (car data)) top-level))
+ (setq data nil)))
+ ;; Return the list of articles.
+ (nreverse articles)))
+
+(defun gnus-summary-rethread-current ()
+ "Rethread the thread the current article is part of."
+ (interactive)
+ (gnus-set-global-variables)
+ (let* ((gnus-show-threads t)
+ (article (gnus-summary-article-number))
+ (id (mail-header-id (gnus-summary-article-header)))
+ (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
+ (unless id
+ (error "No article on the current line"))
+ (gnus-rebuild-thread id)
+ (gnus-summary-goto-subject article)))
+
+(defun gnus-summary-reparent-thread ()
+ "Make the current article child of the marked (or previous) article.
+
+Note that the re-threading will only work if `gnus-thread-ignore-subject'
+is non-nil or the Subject: of both articles are the same."
+ (interactive)
+ (unless (not (gnus-group-read-only-p))
+ (error "The current newsgroup does not support article editing"))
+ (unless (<= (length gnus-newsgroup-processable) 1)
+ (error "No more than one article may be marked"))
+ (save-window-excursion
+ (let ((gnus-article-buffer " *reparent*")
+ (current-article (gnus-summary-article-number))
+ ;; First grab the marked article, otherwise one line up.
+ (parent-article (if (not (null gnus-newsgroup-processable))
+ (car gnus-newsgroup-processable)
+ (save-excursion
+ (if (eq (forward-line -1) 0)
+ (gnus-summary-article-number)
+ (error "Beginning of summary buffer"))))))
+ (unless (not (eq current-article parent-article))
+ (error "An article may not be self-referential"))
+ (let ((message-id (mail-header-id
+ (gnus-summary-article-header parent-article))))
+ (unless (and message-id (not (equal message-id "")))
+ (error "No message-id in desired parent"))
+ (gnus-summary-select-article t t nil current-article)
+ (set-buffer gnus-original-article-buffer)
+ (let ((buf (format "%s" (buffer-string))))
+ (nnheader-temp-write nil
+ (insert buf)
+ (goto-char (point-min))
+ (if (search-forward-regexp "^References: " nil t)
+ (insert message-id " " )
+ (insert "References: " message-id "\n"))
+ (unless (gnus-request-replace-article
+ current-article (car gnus-article-current)
+ (current-buffer))
+ (error "Couldn't replace article"))))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-unmark-all-processable)
+ (gnus-summary-rethread-current)
+ (gnus-message 3 "Article %d is now the child of article %d"
+ current-article parent-article)))))
+
+(defun gnus-summary-toggle-threads (&optional arg)
+ "Toggle showing conversation threads.
+If ARG is positive number, turn showing conversation threads on."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
+ (setq gnus-show-threads
+ (if (null arg) (not gnus-show-threads)
+ (> (prefix-numeric-value arg) 0)))
+ (gnus-summary-prepare)
+ (gnus-summary-goto-subject current)
+ (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-show-all-threads ()
+ "Show all threads."
+ (interactive)
+ (gnus-set-global-variables)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
+ (gnus-summary-position-point))
+
+(defun gnus-summary-show-thread ()
+ "Show thread subtrees.
+Returns nil if no thread was there to be shown."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((buffer-read-only nil)
+ (orig (point))
+ ;; first goto end then to beg, to have point at beg after let
+ (end (progn (end-of-line) (point)))
+ (beg (progn (beginning-of-line) (point))))
+ (prog1
+ ;; Any hidden lines here?
+ (search-forward "\r" end t)
+ (subst-char-in-region beg end ?\^M ?\n t)
+ (goto-char orig)
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-hide-all-threads ()
+ "Hide all thread subtrees."
+ (interactive)
+ (gnus-set-global-variables)
+ (save-excursion
+ (goto-char (point-min))
+ (gnus-summary-hide-thread)
+ (while (zerop (gnus-summary-next-thread 1 t))
+ (gnus-summary-hide-thread)))
+ (gnus-summary-position-point))
+
+(defun gnus-summary-hide-thread ()
+ "Hide thread subtrees.
+Returns nil if no threads were there to be hidden."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((buffer-read-only nil)
+ (start (point))
+ (article (gnus-summary-article-number)))
+ (goto-char start)
+ ;; Go forward until either the buffer ends or the subthread
+ ;; ends.
+ (when (and (not (eobp))
+ (or (zerop (gnus-summary-next-thread 1 t))
+ (goto-char (point-max))))
+ (prog1
+ (if (and (> (point) start)
+ (search-backward "\n" start t))
+ (progn
+ (subst-char-in-region start (point) ?\n ?\^M)
+ (gnus-summary-goto-subject article))
+ (goto-char start)
+ nil)
+ ;;(gnus-summary-position-point)
+ ))))
+
+(defun gnus-summary-go-to-next-thread (&optional previous)
+ "Go to the same level (or less) next thread.
+If PREVIOUS is non-nil, go to previous thread instead.
+Return the article number moved to, or nil if moving was impossible."
+ (let ((level (gnus-summary-thread-level))
+ (way (if previous -1 1))
+ (beg (point)))
+ (forward-line way)
+ (while (and (not (eobp))
+ (< level (gnus-summary-thread-level)))
+ (forward-line way))
+ (if (eobp)
+ (progn
+ (goto-char beg)
+ nil)
+ (setq beg (point))
+ (prog1
+ (gnus-summary-article-number)
+ (goto-char beg)))))
+
+(defun gnus-summary-next-thread (n &optional silent)
+ "Go to the same level next N'th thread.
+If N is negative, search backward instead.
+Returns the difference between N and the number of skips actually
+done.
+
+If SILENT, don't output messages."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (while (and (> n 0)
+ (gnus-summary-go-to-next-thread backward))
+ (decf n))
+ (unless silent
+ (gnus-summary-position-point))
+ (when (and (not silent) (/= 0 n))
+ (gnus-message 7 "No more threads"))
+ n))
+
+(defun gnus-summary-prev-thread (n)
+ "Go to the same level previous N'th thread.
+Returns the difference between N and the number of skips actually
+done."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-summary-next-thread (- n)))
+
+(defun gnus-summary-go-down-thread ()
+ "Go down one level in the current thread."
+ (let ((children (gnus-summary-article-children)))
+ (when children
+ (gnus-summary-goto-subject (car children)))))
+
+(defun gnus-summary-go-up-thread ()
+ "Go up one level in the current thread."
+ (let ((parent (gnus-summary-article-parent)))
+ (when parent
+ (gnus-summary-goto-subject parent))))
+
+(defun gnus-summary-down-thread (n)
+ "Go down thread N steps.
+If N is negative, go up instead.
+Returns the difference between N and how many steps down that were
+taken."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (let ((up (< n 0))
+ (n (abs n)))
+ (while (and (> n 0)
+ (if up (gnus-summary-go-up-thread)
+ (gnus-summary-go-down-thread)))
+ (setq n (1- n)))
+ (gnus-summary-position-point)
+ (when (/= 0 n)
+ (gnus-message 7 "Can't go further"))
+ n))
+
+(defun gnus-summary-up-thread (n)
+ "Go up thread N steps.
+If N is negative, go up instead.
+Returns the difference between N and how many steps down that were
+taken."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-summary-down-thread (- n)))
+
+(defun gnus-summary-top-thread ()
+ "Go to the top of the thread."
+ (interactive)
+ (gnus-set-global-variables)
+ (while (gnus-summary-go-up-thread))
+ (gnus-summary-article-number))
+
+(defun gnus-summary-kill-thread (&optional unmark)
+ "Mark articles under current thread as read.
+If the prefix argument is positive, remove any kinds of marks.
+If the prefix argument is negative, tick articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (when unmark
+ (setq unmark (prefix-numeric-value unmark)))
+ (let ((articles (gnus-summary-articles-in-thread)))
+ (save-excursion
+ ;; Expand the thread.
+ (gnus-summary-show-thread)
+ ;; Mark all the articles.
+ (while articles
+ (gnus-summary-goto-subject (car articles))
+ (cond ((null unmark)
+ (gnus-summary-mark-article-as-read gnus-killed-mark))
+ ((> unmark 0)
+ (gnus-summary-mark-article-as-unread gnus-unread-mark))
+ (t
+ (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
+ (setq articles (cdr articles))))
+ ;; Hide killed subtrees.
+ (and (null unmark)
+ gnus-thread-hide-killed
+ (gnus-summary-hide-thread))
+ ;; If marked as read, go to next unread subject.
+ (when (null unmark)
+ ;; Go to next unread subject.
+ (gnus-summary-next-subject 1 t)))
+ (gnus-set-mode-line 'summary))
+
+;; Summary sorting commands
+
+(defun gnus-summary-sort-by-number (&optional reverse)
+ "Sort the summary buffer by article number.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'number reverse))
+
+(defun gnus-summary-sort-by-author (&optional reverse)
+ "Sort the summary buffer by author name alphabetically.
+If case-fold-search is non-nil, case of letters is ignored.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'author reverse))
+
+(defun gnus-summary-sort-by-subject (&optional reverse)
+ "Sort the summary buffer by subject alphabetically. `Re:'s are ignored.
+If case-fold-search is non-nil, case of letters is ignored.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'subject reverse))
+
+(defun gnus-summary-sort-by-date (&optional reverse)
+ "Sort the summary buffer by date.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'date reverse))
+
+(defun gnus-summary-sort-by-score (&optional reverse)
+ "Sort the summary buffer by score.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'score reverse))
+
+(defun gnus-summary-sort-by-lines (&optional reverse)
+ "Sort the summary buffer by article length.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'lines reverse))
+
+(defun gnus-summary-sort (predicate reverse)
+ "Sort summary buffer by PREDICATE. REVERSE means reverse order."
+ (gnus-set-global-variables)
+ (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
+ (article (intern (format "gnus-article-sort-by-%s" predicate)))
+ (gnus-thread-sort-functions
+ (list
+ (if (not reverse)
+ thread
+ `(lambda (t1 t2)
+ (,thread t2 t1)))))
+ (gnus-article-sort-functions
+ (list
+ (if (not reverse)
+ article
+ `(lambda (t1 t2)
+ (,article t2 t1)))))
+ (buffer-read-only)
+ (gnus-summary-prepare-hook nil))
+ ;; We do the sorting by regenerating the threads.
+ (gnus-summary-prepare)
+ ;; Hide subthreads if needed.
+ (when (and gnus-show-threads gnus-thread-hide-subtree)
+ (gnus-summary-hide-all-threads))))
+
+;; Summary saving commands.
+
+(defun gnus-summary-save-article (&optional n not-saved)
+ "Save the current article using the default saver function.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead.
+The variable `gnus-default-article-saver' specifies the saver function."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let* ((articles (gnus-summary-work-articles n))
+ (save-buffer (save-excursion
+ (nnheader-set-temp-buffer " *Gnus Save*")))
+ (num (length articles))
+ header article file)
+ (while articles
+ (setq header (gnus-summary-article-header
+ (setq article (pop articles))))
+ (if (not (vectorp header))
+ ;; This is a pseudo-article.
+ (if (assq 'name header)
+ (gnus-copy-file (cdr (assq 'name header)))
+ (gnus-message 1 "Article %d is unsaveable" article))
+ ;; This is a real article.
+ (save-window-excursion
+ (gnus-summary-select-article t nil nil article))
+ (save-excursion
+ (set-buffer save-buffer)
+ (erase-buffer)
+ (insert-buffer-substring gnus-original-article-buffer))
+ (setq file (gnus-article-save save-buffer file num))
+ (gnus-summary-remove-process-mark article)
+ (unless not-saved
+ (gnus-summary-set-saved-mark article))))
+ (gnus-kill-buffer save-buffer)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ n))
+
+(defun gnus-summary-pipe-output (&optional arg)
+ "Pipe the current article to a subprocess.
+If N is a positive number, pipe the N next articles.
+If N is a negative number, pipe the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+pipe those articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
+ (gnus-summary-save-article arg t))
+ (gnus-configure-windows 'pipe))
+
+(defun gnus-summary-save-article-mail (&optional arg)
+ "Append the current article to an mail file.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
+ (gnus-summary-save-article arg)))
+
+(defun gnus-summary-save-article-rmail (&optional arg)
+ "Append the current article to an rmail file.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
+ (gnus-summary-save-article arg)))
+
+(defun gnus-summary-save-article-file (&optional arg)
+ "Append the current article to a file.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
+ (gnus-summary-save-article arg)))
+
+(defun gnus-summary-write-article-file (&optional arg)
+ "Write the current article to a file, deleting the previous file.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((gnus-default-article-saver 'gnus-summary-write-to-file))
+ (gnus-summary-save-article arg)))
+
+(defun gnus-summary-save-article-body-file (&optional arg)
+ "Append the current article body to a file.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
+ (gnus-summary-save-article arg)))
+
+(defun gnus-summary-pipe-message (program)
+ "Pipe the current article through PROGRAM."
+ (interactive "sProgram: ")
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (let ((mail-header-separator "")
+ (art-buf (get-buffer gnus-article-buffer)))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (let ((start (window-start))
+ buffer-read-only)
+ (message-pipe-buffer-body program)
+ (set-window-start (get-buffer-window (current-buffer)) start))))))
+
+(defun gnus-get-split-value (methods)
+ "Return a value based on the split METHODS."
+ (let (split-name method result match)
+ (when methods
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (while methods
+ (goto-char (point-min))
+ (setq method (pop methods))
+ (setq match (car method))
+ (when (cond
+ ((stringp match)
+ ;; Regular expression.
+ (ignore-errors
+ (re-search-forward match nil t)))
+ ((gnus-functionp match)
+ ;; Function.
+ (save-restriction
+ (widen)
+ (setq result (funcall match gnus-newsgroup-name))))
+ ((consp match)
+ ;; Form.
+ (save-restriction
+ (widen)
+ (setq result (eval match)))))
+ (setq split-name (append (cdr method) split-name))
+ (cond ((stringp result)
+ (push (expand-file-name
+ result gnus-article-save-directory)
+ split-name))
+ ((consp result)
+ (setq split-name (append result split-name)))))))))
+ split-name))
+
+(defun gnus-valid-move-group-p (group)
+ (and (boundp group)
+ (symbol-name group)
+ (memq 'respool
+ (assoc (symbol-name
+ (car (gnus-find-method-for-group
+ (symbol-name group))))
+ gnus-valid-select-methods))))
+
+(defun gnus-read-move-group-name (prompt default articles prefix)
+ "Read a group name."
+ (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
+ (minibuffer-confirm-incomplete nil) ; XEmacs
+ (prom
+ (format "%s %s to:"
+ prompt
+ (if (> (length articles) 1)
+ (format "these %d articles" (length articles))
+ "this article")))
+ (to-newsgroup
+ (cond
+ ((null split-name)
+ (gnus-completing-read default prom
+ gnus-active-hashtb
+ 'gnus-valid-move-group-p
+ nil prefix
+ 'gnus-group-history))
+ ((= 1 (length split-name))
+ (gnus-completing-read (car split-name) prom
+ gnus-active-hashtb
+ 'gnus-valid-move-group-p
+ nil nil
+ 'gnus-group-history))
+ (t
+ (gnus-completing-read nil prom
+ (mapcar (lambda (el) (list el))
+ (nreverse split-name))
+ nil nil nil
+ 'gnus-group-history)))))
+ (when to-newsgroup
+ (if (or (string= to-newsgroup "")
+ (string= to-newsgroup prefix))
+ (setq to-newsgroup default))
+ (unless to-newsgroup
+ (error "No group name entered"))
+ (or (gnus-active to-newsgroup)
+ (gnus-activate-group to-newsgroup)
+ (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
+ to-newsgroup))
+ (or (and (gnus-request-create-group
+ to-newsgroup (gnus-group-name-to-method to-newsgroup))
+ (gnus-activate-group to-newsgroup nil nil
+ (gnus-group-name-to-method
+ to-newsgroup)))
+ (error "Couldn't create group %s" to-newsgroup)))
+ (error "No such group: %s" to-newsgroup)))
+ to-newsgroup))
+
+;; Summary extract commands
+
+(defun gnus-summary-insert-pseudos (pslist &optional not-view)
+ (let ((buffer-read-only nil)
+ (article (gnus-summary-article-number))
+ after-article b e)
+ (unless (gnus-summary-goto-subject article)
+ (error "No such article: %d" article))
+ (gnus-summary-position-point)
+ ;; If all commands are to be bunched up on one line, we collect
+ ;; them here.
+ (unless gnus-view-pseudos-separately
+ (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
+ files action)
+ (while ps
+ (setq action (cdr (assq 'action (car ps))))
+ (setq files (list (cdr (assq 'name (car ps)))))
+ (while (and ps (cdr ps)
+ (string= (or action "1")
+ (or (cdr (assq 'action (cadr ps))) "2")))
+ (push (cdr (assq 'name (cadr ps))) files)
+ (setcdr ps (cddr ps)))
+ (when files
+ (when (not (string-match "%s" action))
+ (push " " files))
+ (push " " files)
+ (when (assq 'execute (car ps))
+ (setcdr (assq 'execute (car ps))
+ (funcall (if (string-match "%s" action)
+ 'format 'concat)
+ action
+ (mapconcat
+ (lambda (f)
+ (if (equal f " ")
+ f
+ (gnus-quote-arg-for-sh-or-csh f)))
+ files " ")))))
+ (setq ps (cdr ps)))))
+ (if (and gnus-view-pseudos (not not-view))
+ (while pslist
+ (when (assq 'execute (car pslist))
+ (gnus-execute-command (cdr (assq 'execute (car pslist)))
+ (eq gnus-view-pseudos 'not-confirm)))
+ (setq pslist (cdr pslist)))
+ (save-excursion
+ (while pslist
+ (setq after-article (or (cdr (assq 'article (car pslist)))
+ (gnus-summary-article-number)))
+ (gnus-summary-goto-subject after-article)
+ (forward-line 1)
+ (setq b (point))
+ (insert " " (file-name-nondirectory
+ (cdr (assq 'name (car pslist))))
+ ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
+ (setq e (point))
+ (forward-line -1) ; back to `b'
+ (gnus-add-text-properties
+ b (1- e) (list 'gnus-number gnus-reffed-article-number
+ gnus-mouse-face-prop gnus-mouse-face))
+ (gnus-data-enter
+ after-article gnus-reffed-article-number
+ gnus-unread-mark b (car pslist) 0 (- e b))
+ (push gnus-reffed-article-number gnus-newsgroup-unreads)
+ (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
+ (setq pslist (cdr pslist)))))))
+
+(defun gnus-pseudos< (p1 p2)
+ (let ((c1 (cdr (assq 'action p1)))
+ (c2 (cdr (assq 'action p2))))
+ (and c1 c2 (string< c1 c2))))
+
+(defun gnus-request-pseudo-article (props)
+ (cond ((assq 'execute props)
+ (gnus-execute-command (cdr (assq 'execute props)))))
+ (let ((gnus-current-article (gnus-summary-article-number)))
+ (run-hooks 'gnus-mark-article-hook)))
+
+(defun gnus-execute-command (command &optional automatic)
+ (save-excursion
+ (gnus-article-setup-buffer)
+ (set-buffer gnus-article-buffer)
+ (setq buffer-read-only nil)
+ (let ((command (if automatic command
+ (read-string "Command: " (cons command 0)))))
+ (erase-buffer)
+ (insert "$ " command "\n\n")
+ (if gnus-view-pseudo-asynchronously
+ (start-process "gnus-execute" (current-buffer) shell-file-name
+ shell-command-switch command)
+ (call-process shell-file-name nil t nil
+ shell-command-switch command)))))
+
+;; Summary kill commands.
+
+(defun gnus-summary-edit-global-kill (article)
+ "Edit the \"global\" kill file."
+ (interactive (gnus-summary-article-number))
+ (gnus-set-global-variables)
+ (gnus-group-edit-global-kill article))
+
+(defun gnus-summary-edit-local-kill ()
+ "Edit a local kill file applied to the current newsgroup."
+ (interactive)
+ (gnus-set-global-variables)
+ (setq gnus-current-headers (gnus-summary-article-header))
+ (gnus-set-global-variables)
+ (gnus-group-edit-local-kill
+ (gnus-summary-article-number) gnus-newsgroup-name))
+
+;;; Header reading.
+
+(defun gnus-read-header (id &optional header)
+ "Read the headers of article ID and enter them into the Gnus system."
+ (let ((group gnus-newsgroup-name)
+ (gnus-override-method
+ (and (gnus-news-group-p gnus-newsgroup-name)
+ gnus-refer-article-method))
+ where)
+ ;; First we check to see whether the header in question is already
+ ;; fetched.
+ (if (stringp id)
+ ;; This is a Message-ID.
+ (setq header (or header (gnus-id-to-header id)))
+ ;; This is an article number.
+ (setq header (or header (gnus-summary-article-header id))))
+ (if (and header
+ (not (gnus-summary-article-sparse-p (mail-header-number header))))
+ ;; We have found the header.
+ header
+ ;; We have to really fetch the header to this article.
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (when (setq where (gnus-request-head id group))
+ (nnheader-fold-continuation-lines)
+ (goto-char (point-max))
+ (insert ".\n")
+ (goto-char (point-min))
+ (insert "211 ")
+ (princ (cond
+ ((numberp id) id)
+ ((cdr where) (cdr where))
+ (header (mail-header-number header))
+ (t gnus-reffed-article-number))
+ (current-buffer))
+ (insert " Article retrieved.\n"))
+ (if (or (not where)
+ (not (setq header (car (gnus-get-newsgroup-headers nil t)))))
+ () ; Malformed head.
+ (unless (gnus-summary-article-sparse-p (mail-header-number header))
+ (when (and (stringp id)
+ (not (string= (gnus-group-real-name group)
+ (car where))))
+ ;; If we fetched by Message-ID and the article came
+ ;; from a different group, we fudge some bogus article
+ ;; numbers for this article.
+ (mail-header-set-number header gnus-reffed-article-number))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (decf gnus-reffed-article-number)
+ (gnus-remove-header (mail-header-number header))
+ (push header gnus-newsgroup-headers)
+ (setq gnus-current-headers header)
+ (push (mail-header-number header) gnus-newsgroup-limit)))
+ header)))))
+
+(defun gnus-remove-header (number)
+ "Remove header NUMBER from `gnus-newsgroup-headers'."
+ (if (and gnus-newsgroup-headers
+ (= number (mail-header-number (car gnus-newsgroup-headers))))
+ (pop gnus-newsgroup-headers)
+ (let ((headers gnus-newsgroup-headers))
+ (while (and (cdr headers)
+ (not (= number (mail-header-number (cadr headers)))))
+ (pop headers))
+ (when (cdr headers)
+ (setcdr headers (cddr headers))))))
+
+;;;
+;;; summary highlights
+;;;
+
+(defun gnus-highlight-selected-summary ()
+ ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
+ ;; Highlight selected article in summary buffer
+ (when gnus-summary-selected-face
+ (save-excursion
+ (let* ((beg (progn (beginning-of-line) (point)))
+ (end (progn (end-of-line) (point)))
+ ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
+ (from (if (get-text-property beg gnus-mouse-face-prop)
+ beg
+ (or (next-single-property-change
+ beg gnus-mouse-face-prop nil end)
+ beg)))
+ (to
+ (if (= from end)
+ (- from 2)
+ (or (next-single-property-change
+ from gnus-mouse-face-prop nil end)
+ end))))
+ ;; If no mouse-face prop on line we will have to = from = end,
+ ;; so we highlight the entire line instead.
+ (when (= (+ to 2) from)
+ (setq from beg)
+ (setq to end))
+ (if gnus-newsgroup-selected-overlay
+ ;; Move old overlay.
+ (gnus-move-overlay
+ gnus-newsgroup-selected-overlay from to (current-buffer))
+ ;; Create new overlay.
+ (gnus-overlay-put
+ (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
+ 'face gnus-summary-selected-face))))))
+
+;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
+(defun gnus-summary-highlight-line ()
+ "Highlight current line according to `gnus-summary-highlight'."
+ (let* ((list gnus-summary-highlight)
+ (p (point))
+ (end (progn (end-of-line) (point)))
+ ;; now find out where the line starts and leave point there.
+ (beg (progn (beginning-of-line) (point)))
+ (article (gnus-summary-article-number))
+ (score (or (cdr (assq (or article gnus-current-article)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0))
+ (mark (or (gnus-summary-article-mark) gnus-unread-mark))
+ (inhibit-read-only t))
+ ;; Eval the cars of the lists until we find a match.
+ (let ((default gnus-summary-default-score))
+ (while (and list
+ (not (eval (caar list))))
+ (setq list (cdr list))))
+ (let ((face (cdar list)))
+ (unless (eq face (get-text-property beg 'face))
+ (gnus-put-text-property
+ beg end 'face
+ (setq face (if (boundp face) (symbol-value face) face)))
+ (when gnus-summary-highlight-line-function
+ (funcall gnus-summary-highlight-line-function article face))))
+ (goto-char p)))
+
+(defun gnus-update-read-articles (group unread &optional compute)
+ "Update the list of read articles in GROUP."
+ (let* ((active (or gnus-newsgroup-active (gnus-active group)))
+ (entry (gnus-gethash group gnus-newsrc-hashtb))
+ (info (nth 2 entry))
+ (prev 1)
+ (unread (sort (copy-sequence unread) '<))
+ read)
+ (if (or (not info) (not active))
+ ;; There is no info on this group if it was, in fact,
+ ;; killed. Gnus stores no information on killed groups, so
+ ;; there's nothing to be done.
+ ;; One could store the information somewhere temporarily,
+ ;; perhaps... Hmmm...
+ ()
+ ;; Remove any negative articles numbers.
+ (while (and unread (< (car unread) 0))
+ (setq unread (cdr unread)))
+ ;; Remove any expired article numbers
+ (while (and unread (< (car unread) (car active)))
+ (setq unread (cdr unread)))
+ ;; Compute the ranges of read articles by looking at the list of
+ ;; unread articles.
+ (while unread
+ (when (/= (car unread) prev)
+ (push (if (= prev (1- (car unread))) prev
+ (cons prev (1- (car unread))))
+ read))
+ (setq prev (1+ (car unread)))
+ (setq unread (cdr unread)))
+ (when (<= prev (cdr active))
+ (push (cons prev (cdr active)) read))
+ (if compute
+ (if (> (length read) 1) (nreverse read) read)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
+ ;; Enter this list into the group info.
+ (gnus-info-set-read
+ info (if (> (length read) 1) (nreverse read) read))
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+ t))))
+
+(defun gnus-offer-save-summaries ()
+ "Offer to save all active summary buffers."
+ (save-excursion
+ (let ((buflist (buffer-list))
+ buffers bufname)
+ ;; Go through all buffers and find all summaries.
+ (while buflist
+ (and (setq bufname (buffer-name (car buflist)))
+ (string-match "Summary" bufname)
+ (save-excursion
+ (set-buffer bufname)
+ ;; We check that this is, indeed, a summary buffer.
+ (and (eq major-mode 'gnus-summary-mode)
+ ;; Also make sure this isn't bogus.
+ gnus-newsgroup-prepared
+ ;; Also make sure that this isn't a dead summary buffer.
+ (not gnus-dead-summary-mode)))
+ (push bufname buffers))
+ (setq buflist (cdr buflist)))
+ ;; Go through all these summary buffers and offer to save them.
+ (when buffers
+ (map-y-or-n-p
+ "Update summary buffer %s? "
+ (lambda (buf) (switch-to-buffer buf) (gnus-summary-exit))
+ buffers)))))
+
+(gnus-ems-redefine)
+
+(provide 'gnus-sum)
+
+(run-hooks 'gnus-sum-load-hook)
+
+;;; gnus-sum.el ends here
--- /dev/null
+;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Ilja Weis <kult@uni-paderborn.de>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-group)
+(require 'gnus-start)
+
+(defgroup gnus-topic nil
+ "Group topics."
+ :group 'gnus-group)
+
+(defvar gnus-topic-mode nil
+ "Minor mode for Gnus group buffers.")
+
+(defcustom gnus-topic-mode-hook nil
+ "Hook run in topic mode buffers."
+ :type 'hook
+ :group 'gnus-topic)
+
+(defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
+ "Format of topic lines.
+It works along the same lines as a normal formatting string,
+with some simple extensions.
+
+%i Indentation based on topic level.
+%n Topic name.
+%v Nothing if the topic is visible, \"...\" otherwise.
+%g Number of groups in the topic.
+%a Number of unread articles in the groups in the topic.
+%A Number of unread articles in the groups in the topic and its subtopics.
+"
+ :type 'string
+ :group 'gnus-topic)
+
+(defcustom gnus-topic-indent-level 2
+ "*How much each subtopic should be indented."
+ :type 'integer
+ :group 'gnus-topic)
+
+(defcustom gnus-topic-display-empty-topics t
+ "*If non-nil, display the topic lines even of topics that have no unread articles."
+ :type 'boolean
+ :group 'gnus-topic)
+
+;; Internal variables.
+
+(defvar gnus-topic-active-topology nil)
+(defvar gnus-topic-active-alist nil)
+
+(defvar gnus-topology-checked-p nil
+ "Whether the topology has been checked in this session.")
+
+(defvar gnus-topic-killed-topics nil)
+(defvar gnus-topic-inhibit-change-level nil)
+
+(defconst gnus-topic-line-format-alist
+ `((?n name ?s)
+ (?v visible ?s)
+ (?i indentation ?s)
+ (?g number-of-groups ?d)
+ (?a (gnus-topic-articles-in-topic entries) ?d)
+ (?A total-number-of-articles ?d)
+ (?l level ?d)))
+
+(defvar gnus-topic-line-format-spec nil)
+
+;;; Utility functions
+
+(defun gnus-group-topic-name ()
+ "The name of the topic on the current line."
+ (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic)))
+ (and topic (symbol-name topic))))
+
+(defun gnus-group-topic-level ()
+ "The level of the topic on the current line."
+ (get-text-property (gnus-point-at-bol) 'gnus-topic-level))
+
+(defun gnus-group-topic-unread ()
+ "The number of unread articles in topic on the current line."
+ (get-text-property (gnus-point-at-bol) 'gnus-topic-unread))
+
+(defun gnus-topic-unread (topic)
+ "Return the number of unread articles in TOPIC."
+ (or (save-excursion
+ (and (gnus-topic-goto-topic topic)
+ (gnus-group-topic-unread)))
+ 0))
+
+(defun gnus-group-topic-p ()
+ "Return non-nil if the current line is a topic."
+ (gnus-group-topic-name))
+
+(defun gnus-topic-visible-p ()
+ "Return non-nil if the current topic is visible."
+ (get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
+
+(defun gnus-topic-articles-in-topic (entries)
+ (let ((total 0)
+ number)
+ (while entries
+ (when (numberp (setq number (car (pop entries))))
+ (incf total number)))
+ total))
+
+(defun gnus-group-topic (group)
+ "Return the topic GROUP is a member of."
+ (let ((alist gnus-topic-alist)
+ out)
+ (while alist
+ (when (member group (cdar alist))
+ (setq out (caar alist)
+ alist nil))
+ (setq alist (cdr alist)))
+ out))
+
+(defun gnus-group-parent-topic (group)
+ "Return the topic GROUP is member of by looking at the group buffer."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (if (gnus-group-goto-group group)
+ (gnus-current-topic)
+ (gnus-group-topic group))))
+
+(defun gnus-topic-goto-topic (topic)
+ "Go to TOPIC."
+ (when topic
+ (gnus-goto-char (text-property-any (point-min) (point-max)
+ 'gnus-topic (intern topic)))))
+
+(defun gnus-current-topic ()
+ "Return the name of the current topic."
+ (let ((result
+ (or (get-text-property (point) 'gnus-topic)
+ (save-excursion
+ (and (gnus-goto-char (previous-single-property-change
+ (point) 'gnus-topic))
+ (get-text-property (max (1- (point)) (point-min))
+ 'gnus-topic))))))
+ (when result
+ (symbol-name result))))
+
+(defun gnus-current-topics ()
+ "Return a list of all current topics, lowest in hierarchy first."
+ (let ((topic (gnus-current-topic))
+ topics)
+ (while topic
+ (push topic topics)
+ (setq topic (gnus-topic-parent-topic topic)))
+ (nreverse topics)))
+
+(defun gnus-group-active-topic-p ()
+ "Say whether the current topic comes from the active topics."
+ (save-excursion
+ (beginning-of-line)
+ (get-text-property (point) 'gnus-active)))
+
+(defun gnus-topic-find-groups (topic &optional level all lowest)
+ "Return entries for all visible groups in TOPIC."
+ (let ((groups (cdr (assoc topic gnus-topic-alist)))
+ info clevel unread group params visible-groups entry active)
+ (setq lowest (or lowest 1))
+ (setq level (or level 7))
+ ;; We go through the newsrc to look for matches.
+ (while groups
+ (when (setq group (pop groups))
+ (setq entry (gnus-gethash group gnus-newsrc-hashtb)
+ info (nth 2 entry)
+ params (gnus-info-params info)
+ active (gnus-active group)
+ unread (or (car entry)
+ (and (not (equal group "dummy.group"))
+ active
+ (- (1+ (cdr active)) (car active))))
+ clevel (or (gnus-info-level info)
+ (if (member group gnus-zombie-list) 8 9))))
+ (and
+ unread ; nil means that the group is dead.
+ (<= clevel level)
+ (>= clevel lowest) ; Is inside the level we want.
+ (or all
+ (if (eq unread t)
+ gnus-group-list-inactive-groups
+ (> unread 0))
+ (and gnus-list-groups-with-ticked-articles
+ (cdr (assq 'tick (gnus-info-marks info))))
+ ; Has right readedness.
+ ;; Check for permanent visibility.
+ (and gnus-permanently-visible-groups
+ (string-match gnus-permanently-visible-groups group))
+ (memq 'visible params)
+ (cdr (assq 'visible params)))
+ ;; Add this group to the list of visible groups.
+ (push (or entry group) visible-groups)))
+ (nreverse visible-groups)))
+
+(defun gnus-topic-previous-topic (topic)
+ "Return the previous topic on the same level as TOPIC."
+ (let ((top (cddr (gnus-topic-find-topology
+ (gnus-topic-parent-topic topic)))))
+ (unless (equal topic (caaar top))
+ (while (and top (not (equal (caaadr top) topic)))
+ (setq top (cdr top)))
+ (caaar top))))
+
+(defun gnus-topic-parent-topic (topic &optional topology)
+ "Return the parent of TOPIC."
+ (unless topology
+ (setq topology gnus-topic-topology))
+ (let ((parent (car (pop topology)))
+ result found)
+ (while (and topology
+ (not (setq found (equal (caaar topology) topic)))
+ (not (setq result (gnus-topic-parent-topic
+ topic (car topology)))))
+ (setq topology (cdr topology)))
+ (or result (and found parent))))
+
+(defun gnus-topic-next-topic (topic &optional previous)
+ "Return the next sibling of TOPIC."
+ (let ((parentt (cddr (gnus-topic-find-topology
+ (gnus-topic-parent-topic topic))))
+ prev)
+ (while (and parentt
+ (not (equal (caaar parentt) topic)))
+ (setq prev (caaar parentt)
+ parentt (cdr parentt)))
+ (if previous
+ prev
+ (caaadr parentt))))
+
+(defun gnus-topic-forward-topic (num)
+ "Go to the next topic on the same level as the current one."
+ (let* ((topic (gnus-current-topic))
+ (way (if (< num 0) 'gnus-topic-previous-topic
+ 'gnus-topic-next-topic))
+ (num (abs num)))
+ (while (and (not (zerop num))
+ (setq topic (funcall way topic)))
+ (when (gnus-topic-goto-topic topic)
+ (decf num)))
+ (unless (zerop num)
+ (goto-char (point-max)))
+ num))
+
+(defun gnus-topic-find-topology (topic &optional topology level remove)
+ "Return the topology of TOPIC."
+ (unless topology
+ (setq topology gnus-topic-topology)
+ (setq level 0))
+ (let ((top topology)
+ result)
+ (if (equal (caar topology) topic)
+ (progn
+ (when remove
+ (delq topology remove))
+ (cons level topology))
+ (setq topology (cdr topology))
+ (while (and topology
+ (not (setq result (gnus-topic-find-topology
+ topic (car topology) (1+ level)
+ (and remove top)))))
+ (setq topology (cdr topology)))
+ result)))
+
+(defvar gnus-tmp-topics nil)
+(defun gnus-topic-list (&optional topology)
+ "Return a list of all topics in the topology."
+ (unless topology
+ (setq topology gnus-topic-topology
+ gnus-tmp-topics nil))
+ (push (caar topology) gnus-tmp-topics)
+ (mapcar 'gnus-topic-list (cdr topology))
+ gnus-tmp-topics)
+
+;;; Topic parameter jazz
+
+(defun gnus-topic-parameters (topic)
+ "Return the parameters for TOPIC."
+ (let ((top (gnus-topic-find-topology topic)))
+ (when top
+ (nth 3 (cadr top)))))
+
+(defun gnus-topic-set-parameters (topic parameters)
+ "Set the topic parameters of TOPIC to PARAMETERS."
+ (let ((top (gnus-topic-find-topology topic)))
+ (unless top
+ (error "No such topic: %s" topic))
+ ;; We may have to extend if there is no parameters here
+ ;; to begin with.
+ (unless (nthcdr 2 (cadr top))
+ (nconc (cadr top) (list nil)))
+ (unless (nthcdr 3 (cadr top))
+ (nconc (cadr top) (list nil)))
+ (setcar (nthcdr 3 (cadr top)) parameters)
+ (gnus-dribble-enter
+ (format "(gnus-topic-set-parameters %S '%S)" topic parameters))))
+
+(defun gnus-group-topic-parameters (group)
+ "Compute the group parameters for GROUP taking into account inheritance from topics."
+ (let ((params-list (list (gnus-group-get-parameter group)))
+ topics params param out)
+ (save-excursion
+ (gnus-group-goto-group group)
+ (setq topics (gnus-current-topics))
+ (while topics
+ (push (gnus-topic-parameters (pop topics)) params-list))
+ ;; We probably have lots of nil elements here, so
+ ;; we remove them. Probably faster than doing this "properly".
+ (setq params-list (delq nil params-list))
+ ;; Now we have all the parameters, so we go through them
+ ;; and do inheritance in the obvious way.
+ (while (setq params (pop params-list))
+ (while (setq param (pop params))
+ (when (atom param)
+ (setq param (cons param t)))
+ ;; Override any old versions of this param.
+ (setq out (delq (assq (car param) out) out))
+ (push param out)))
+ ;; Return the resulting parameter list.
+ out)))
+
+;;; General utility functions
+
+(defun gnus-topic-enter-dribble ()
+ (gnus-dribble-enter
+ (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
+
+;;; Generating group buffers
+
+(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level)
+ "List all newsgroups with unread articles of level LEVEL or lower, and
+use the `gnus-group-topics' to sort the groups.
+If ALL is non-nil, list groups that have no unread articles.
+If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
+ (set-buffer gnus-group-buffer)
+ (let ((buffer-read-only nil)
+ (lowest (or lowest 1)))
+
+ (when (or (not gnus-topic-alist)
+ (not gnus-topology-checked-p))
+ (gnus-topic-check-topology))
+
+ (unless list-topic
+ (erase-buffer))
+
+ ;; List dead groups?
+ (when (and (>= level gnus-level-zombie)
+ (<= lowest gnus-level-zombie))
+ (gnus-group-prepare-flat-list-dead
+ (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+ gnus-level-zombie ?Z
+ regexp))
+
+ (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))
+ (gnus-group-prepare-flat-list-dead
+ (setq gnus-killed-list (sort gnus-killed-list 'string<))
+ gnus-level-killed ?K
+ regexp))
+
+ ;; Use topics.
+ (prog1
+ (when (< lowest gnus-level-zombie)
+ (if list-topic
+ (let ((top (gnus-topic-find-topology list-topic)))
+ (gnus-topic-prepare-topic (cdr top) (car top)
+ (or topic-level level) all
+ nil lowest))
+ (gnus-topic-prepare-topic gnus-topic-topology 0
+ (or topic-level level) all
+ nil lowest)))
+
+ (gnus-group-set-mode-line)
+ (setq gnus-group-list-mode (cons level all))
+ (run-hooks 'gnus-group-prepare-hook))))
+
+(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent
+ lowest)
+ "Insert TOPIC into the group buffer.
+If SILENT, don't insert anything. Return the number of unread
+articles in the topic and its subtopics."
+ (let* ((type (pop topicl))
+ (entries (gnus-topic-find-groups (car type) list-level all lowest))
+ (visiblep (and (eq (nth 1 type) 'visible) (not silent)))
+ (gnus-group-indentation
+ (make-string (* gnus-topic-indent-level level) ? ))
+ (beg (progn (beginning-of-line) (point)))
+ (topicl (reverse topicl))
+ (all-entries entries)
+ (point-max (point-max))
+ (unread 0)
+ (topic (car type))
+ info entry end active tick)
+ ;; Insert any sub-topics.
+ (while topicl
+ (incf unread
+ (gnus-topic-prepare-topic
+ (pop topicl) (1+ level) list-level all
+ (not visiblep) lowest)))
+ (setq end (point))
+ (goto-char beg)
+ ;; Insert all the groups that belong in this topic.
+ (while (setq entry (pop entries))
+ (when visiblep
+ (if (stringp entry)
+ ;; Dead groups.
+ (gnus-group-insert-group-line
+ entry (if (member entry gnus-zombie-list) 8 9)
+ nil (- (1+ (cdr (setq active (gnus-active entry))))
+ (car active))
+ nil)
+ ;; Living groups.
+ (when (setq info (nth 2 entry))
+ (gnus-group-insert-group-line
+ (gnus-info-group info)
+ (gnus-info-level info) (gnus-info-marks info)
+ (car entry) (gnus-info-method info)))))
+ (when (and (listp entry)
+ (numberp (car entry)))
+ (incf unread (car entry)))
+ (when (listp entry)
+ (setq tick t)))
+ (goto-char beg)
+ ;; Insert the topic line.
+ (when (and (not silent)
+ (or gnus-topic-display-empty-topics ;We want empty topics
+ (not (zerop unread)) ;Non-empty
+ tick ;Ticked articles
+ (/= point-max (point-max)))) ;Unactivated groups
+ (gnus-extent-start-open (point))
+ (gnus-topic-insert-topic-line
+ (car type) visiblep
+ (not (eq (nth 2 type) 'hidden))
+ level all-entries unread))
+ (goto-char end)
+ unread))
+
+(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level)
+ "Remove the current topic."
+ (let ((topic (gnus-group-topic-name))
+ (level (gnus-group-topic-level))
+ (beg (progn (beginning-of-line) (point)))
+ buffer-read-only)
+ (when topic
+ (while (and (zerop (forward-line 1))
+ (> (or (gnus-group-topic-level) (1+ level)) level)))
+ (delete-region beg (point))
+ ;; Do the change in this rather odd manner because it has been
+ ;; reported that some topics share parts of some lists, for some
+ ;; reason. I have been unable to determine why this is the
+ ;; case, but this hack seems to take care of things.
+ (let ((data (cadr (gnus-topic-find-topology topic))))
+ (setcdr data
+ (list (if insert 'visible 'invisible)
+ (if hide 'hide nil)
+ (cadddr data))))
+ (if total-remove
+ (setq gnus-topic-alist
+ (delq (assoc topic gnus-topic-alist) gnus-topic-alist))
+ (gnus-topic-insert-topic topic in-level)))))
+
+(defun gnus-topic-insert-topic (topic &optional level)
+ "Insert TOPIC."
+ (gnus-group-prepare-topics
+ (car gnus-group-list-mode) (cdr gnus-group-list-mode)
+ nil nil topic level))
+
+(defun gnus-topic-fold (&optional insert)
+ "Remove/insert the current topic."
+ (let ((topic (gnus-group-topic-name)))
+ (when topic
+ (save-excursion
+ (if (not (gnus-group-active-topic-p))
+ (gnus-topic-remove-topic
+ (or insert (not (gnus-topic-visible-p))))
+ (let ((gnus-topic-topology gnus-topic-active-topology)
+ (gnus-topic-alist gnus-topic-active-alist)
+ (gnus-group-list-mode (cons 5 t)))
+ (gnus-topic-remove-topic
+ (or insert (not (gnus-topic-visible-p))) nil nil 9)
+ (gnus-topic-enter-dribble)))))))
+
+(defun gnus-topic-insert-topic-line (name visiblep shownp level entries
+ &optional unread)
+ (let* ((visible (if visiblep "" "..."))
+ (indentation (make-string (* gnus-topic-indent-level level) ? ))
+ (total-number-of-articles unread)
+ (number-of-groups (length entries))
+ (active-topic (eq gnus-topic-alist gnus-topic-active-alist)))
+ (beginning-of-line)
+ ;; Insert the text.
+ (gnus-add-text-properties
+ (point)
+ (prog1 (1+ (point))
+ (eval gnus-topic-line-format-spec))
+ (list 'gnus-topic (intern name)
+ 'gnus-topic-level level
+ 'gnus-topic-unread unread
+ 'gnus-active active-topic
+ 'gnus-topic-visible visiblep))))
+
+(defun gnus-topic-update-topics-containing-group (group)
+ "Update all topics that have GROUP as a member."
+ (when (and (eq major-mode 'gnus-group-mode)
+ gnus-topic-mode)
+ (save-excursion
+ (let ((alist gnus-topic-alist))
+ ;; This is probably not entirely correct. If a topic
+ ;; isn't shown, then it's not updated. But the updating
+ ;; should be performed in any case, since the topic's
+ ;; parent should be updated. Pfft.
+ (while alist
+ (when (and (member group (cdar alist))
+ (gnus-topic-goto-topic (caar alist)))
+ (gnus-topic-update-topic-line (caar alist)))
+ (pop alist))))))
+
+(defun gnus-topic-update-topic ()
+ "Update all parent topics to the current group."
+ (when (and (eq major-mode 'gnus-group-mode)
+ gnus-topic-mode)
+ (let ((group (gnus-group-group-name))
+ (m (point-marker))
+ (buffer-read-only nil))
+ (when (and group
+ (gnus-get-info group)
+ (gnus-topic-goto-topic (gnus-current-topic)))
+ (gnus-topic-update-topic-line (gnus-group-topic-name))
+ (goto-char m)
+ (set-marker m nil)
+ (gnus-group-position-point)))))
+
+(defun gnus-topic-goto-missing-group (group)
+ "Place point where GROUP is supposed to be inserted."
+ (let* ((topic (gnus-group-topic group))
+ (groups (cdr (assoc topic gnus-topic-alist)))
+ (g (cdr (member group groups)))
+ (unfound t))
+ ;; Try to jump to a visible group.
+ (while (and g (not (gnus-group-goto-group (car g) t)))
+ (pop g))
+ ;; It wasn't visible, so we try to see where to insert it.
+ (when (not g)
+ (setq g (cdr (member group (reverse groups))))
+ (while (and g unfound)
+ (when (gnus-group-goto-group (pop g) t)
+ (forward-line 1)
+ (setq unfound nil)))
+ (when (and unfound
+ topic
+ (not (gnus-topic-goto-missing-topic topic)))
+ (gnus-topic-insert-topic-line
+ topic t t (car (gnus-topic-find-topology topic)) nil 0)))))
+
+(defun gnus-topic-goto-missing-topic (topic)
+ (if (gnus-topic-goto-topic topic)
+ (forward-line 1)
+ ;; Topic not displayed.
+ (let* ((top (gnus-topic-find-topology
+ (gnus-topic-parent-topic topic)))
+ (tp (reverse (cddr top))))
+ (while (not (equal (caaar tp) topic))
+ (setq tp (cdr tp)))
+ (pop tp)
+ (while (and tp
+ (not (gnus-topic-goto-topic (caaar tp))))
+ (pop tp))
+ (if tp
+ (gnus-topic-forward-topic 1)
+ (gnus-topic-goto-missing-topic (caadr top))))
+ nil))
+
+(defun gnus-topic-update-topic-line (topic-name &optional reads)
+ (let* ((top (gnus-topic-find-topology topic-name))
+ (type (cadr top))
+ (children (cddr top))
+ (entries (gnus-topic-find-groups
+ (car type) (car gnus-group-list-mode)
+ (cdr gnus-group-list-mode)))
+ (parent (gnus-topic-parent-topic topic-name))
+ (all-entries entries)
+ (unread 0)
+ old-unread entry)
+ (when (gnus-topic-goto-topic (car type))
+ ;; Tally all the groups that belong in this topic.
+ (if reads
+ (setq unread (- (gnus-group-topic-unread) reads))
+ (while children
+ (incf unread (gnus-topic-unread (caar (pop children)))))
+ (while (setq entry (pop entries))
+ (when (numberp (car entry))
+ (incf unread (car entry)))))
+ (setq old-unread (gnus-group-topic-unread))
+ ;; Insert the topic line.
+ (gnus-topic-insert-topic-line
+ (car type) (gnus-topic-visible-p)
+ (not (eq (nth 2 type) 'hidden))
+ (gnus-group-topic-level) all-entries unread)
+ (gnus-delete-line))
+ (when parent
+ (forward-line -1)
+ (gnus-topic-update-topic-line
+ parent (- old-unread (gnus-group-topic-unread))))
+ unread))
+
+(defun gnus-topic-group-indentation ()
+ (make-string
+ (* gnus-topic-indent-level
+ (or (save-excursion
+ (forward-line -1)
+ (gnus-topic-goto-topic (gnus-current-topic))
+ (gnus-group-topic-level))
+ 0))
+ ? ))
+
+;;; Initialization
+
+(gnus-add-shutdown 'gnus-topic-close 'gnus)
+
+(defun gnus-topic-close ()
+ (setq gnus-topic-active-topology nil
+ gnus-topic-active-alist nil
+ gnus-topic-killed-topics nil
+ gnus-topology-checked-p nil))
+
+(defun gnus-topic-check-topology ()
+ ;; The first time we set the topology to whatever we have
+ ;; gotten here, which can be rather random.
+ (unless gnus-topic-alist
+ (gnus-topic-init-alist))
+
+ (setq gnus-topology-checked-p t)
+ ;; Go through the topic alist and make sure that all topics
+ ;; are in the topic topology.
+ (let ((topics (gnus-topic-list))
+ (alist gnus-topic-alist)
+ changed)
+ (while alist
+ (unless (member (caar alist) topics)
+ (nconc gnus-topic-topology
+ (list (list (list (caar alist) 'visible))))
+ (setq changed t))
+ (setq alist (cdr alist)))
+ (when changed
+ (gnus-topic-enter-dribble))
+ ;; Conversely, go through the topology and make sure that all
+ ;; topologies have alists.
+ (while topics
+ (unless (assoc (car topics) gnus-topic-alist)
+ (push (list (car topics)) gnus-topic-alist))
+ (pop topics)))
+ ;; Go through all living groups and make sure that
+ ;; they belong to some topic.
+ (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
+ gnus-topic-alist)))
+ (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist)))
+ (newsrc (cdr gnus-newsrc-alist))
+ group)
+ (while newsrc
+ (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
+ (setcdr entry (list group))
+ (setq entry (cdr entry)))))
+ ;; Go through all topics and make sure they contain only living groups.
+ (let ((alist gnus-topic-alist)
+ topic)
+ (while (setq topic (pop alist))
+ (while (cdr topic)
+ (if (and (cadr topic)
+ (gnus-gethash (cadr topic) gnus-newsrc-hashtb))
+ (setq topic (cdr topic))
+ (setcdr topic (cddr topic)))))))
+
+(defun gnus-topic-init-alist ()
+ "Initialize the topic structures."
+ (setq gnus-topic-topology
+ (cons (list "Gnus" 'visible)
+ (mapcar (lambda (topic)
+ (list (list (car topic) 'visible)))
+ '(("misc")))))
+ (setq gnus-topic-alist
+ (list (cons "misc"
+ (mapcar (lambda (info) (gnus-info-group info))
+ (cdr gnus-newsrc-alist)))
+ (list "Gnus")))
+ (gnus-topic-enter-dribble))
+
+;;; Maintenance
+
+(defun gnus-topic-clean-alist ()
+ "Remove bogus groups from the topic alist."
+ (let ((topic-alist gnus-topic-alist)
+ result topic)
+ (unless gnus-killed-hashtb
+ (gnus-make-hashtable-from-killed))
+ (while (setq topic (pop topic-alist))
+ (let ((topic-name (pop topic))
+ group filtered-topic)
+ (while (setq group (pop topic))
+ (when (and (or (gnus-gethash group gnus-active-hashtb)
+ (gnus-info-method (gnus-get-info group)))
+ (not (gnus-gethash group gnus-killed-hashtb)))
+ (push group filtered-topic)))
+ (push (cons topic-name (nreverse filtered-topic)) result)))
+ (setq gnus-topic-alist (nreverse result))))
+
+(defun gnus-topic-change-level (group level oldlevel &optional previous)
+ "Run when changing levels to enter/remove groups from topics."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-group-goto-group (or (car (nth 2 previous)) group))
+ (when (and gnus-topic-mode
+ gnus-topic-alist
+ (not gnus-topic-inhibit-change-level))
+ ;; Remove the group from the topics.
+ (when (and (< oldlevel gnus-level-zombie)
+ (>= level gnus-level-zombie))
+ (let (alist)
+ (forward-line -1)
+ (when (setq alist (assoc (gnus-current-topic) gnus-topic-alist))
+ (setcdr alist (gnus-delete-first group (cdr alist))))))
+ ;; If the group is subscribed we enter it into the topics.
+ (when (and (< level gnus-level-zombie)
+ (>= oldlevel gnus-level-zombie))
+ (let* ((prev (gnus-group-group-name))
+ (gnus-topic-inhibit-change-level t)
+ (gnus-group-indentation
+ (make-string
+ (* gnus-topic-indent-level
+ (or (save-excursion
+ (gnus-topic-goto-topic (gnus-current-topic))
+ (gnus-group-topic-level))
+ 0))
+ ? ))
+ (yanked (list group))
+ alist talist end)
+ ;; Then we enter the yanked groups into the topics they belong
+ ;; to.
+ (when (setq alist (assoc (save-excursion
+ (forward-line -1)
+ (or
+ (gnus-current-topic)
+ (caar gnus-topic-topology)))
+ gnus-topic-alist))
+ (setq talist alist)
+ (when (stringp yanked)
+ (setq yanked (list yanked)))
+ (if (not prev)
+ (nconc alist yanked)
+ (if (not (cdr alist))
+ (setcdr alist (nconc yanked (cdr alist)))
+ (while (and (not end) (cdr alist))
+ (when (equal (cadr alist) prev)
+ (setcdr alist (nconc yanked (cdr alist)))
+ (setq end t))
+ (setq alist (cdr alist)))
+ (unless end
+ (nconc talist yanked))))))
+ (gnus-topic-update-topic)))))
+
+(defun gnus-topic-goto-next-group (group props)
+ "Go to group or the next group after group."
+ (if (not group)
+ (if (not (memq 'gnus-topic props))
+ (goto-char (point-max))
+ (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props)))))
+ (if (gnus-group-goto-group group)
+ t
+ ;; The group is no longer visible.
+ (let* ((list (assoc (gnus-group-topic group) gnus-topic-alist))
+ (after (cdr (member group (cdr list)))))
+ ;; First try to put point on a group after the current one.
+ (while (and after
+ (not (gnus-group-goto-group (car after))))
+ (setq after (cdr after)))
+ ;; Then try to put point on a group before point.
+ (unless after
+ (setq after (cdr (member group (reverse (cdr list)))))
+ (while (and after
+ (not (gnus-group-goto-group (car after))))
+ (setq after (cdr after))))
+ ;; Finally, just put point on the topic.
+ (if (not (car list))
+ (goto-char (point-min))
+ (unless after
+ (gnus-topic-goto-topic (car list))
+ (setq after nil)))
+ t))))
+
+;;; Topic-active functions
+
+(defun gnus-topic-grok-active (&optional force)
+ "Parse all active groups and create topic structures for them."
+ ;; First we make sure that we have really read the active file.
+ (when (or force
+ (not gnus-topic-active-alist))
+ (let (groups)
+ ;; Get a list of all groups available.
+ (mapatoms (lambda (g) (when (symbol-value g)
+ (push (symbol-name g) groups)))
+ gnus-active-hashtb)
+ (setq groups (sort groups 'string<))
+ ;; Init the variables.
+ (setq gnus-topic-active-topology (list (list "" 'visible)))
+ (setq gnus-topic-active-alist nil)
+ ;; Descend the top-level hierarchy.
+ (gnus-topic-grok-active-1 gnus-topic-active-topology groups)
+ ;; Set the top-level topic names to something nice.
+ (setcar (car gnus-topic-active-topology) "Gnus active")
+ (setcar (car gnus-topic-active-alist) "Gnus active"))))
+
+(defun gnus-topic-grok-active-1 (topology groups)
+ (let* ((name (caar topology))
+ (prefix (concat "^" (regexp-quote name)))
+ tgroups ntopology group)
+ (while (and groups
+ (string-match prefix (setq group (car groups))))
+ (if (not (string-match "\\." group (match-end 0)))
+ ;; There are no further hierarchies here, so we just
+ ;; enter this group into the list belonging to this
+ ;; topic.
+ (push (pop groups) tgroups)
+ ;; New sub-hierarchy, so we add it to the topology.
+ (nconc topology (list (setq ntopology
+ (list (list (substring
+ group 0 (match-end 0))
+ 'invisible)))))
+ ;; Descend the hierarchy.
+ (setq groups (gnus-topic-grok-active-1 ntopology groups))))
+ ;; We remove the trailing "." from the topic name.
+ (setq name
+ (if (string-match "\\.$" name)
+ (substring name 0 (match-beginning 0))
+ name))
+ ;; Add this topic and its groups to the topic alist.
+ (push (cons name (nreverse tgroups)) gnus-topic-active-alist)
+ (setcar (car topology) name)
+ ;; We return the rest of the groups that didn't belong
+ ;; to this topic.
+ groups))
+
+;;; Topic mode, commands and keymap.
+
+(defvar gnus-topic-mode-map nil)
+(defvar gnus-group-topic-map nil)
+
+(unless gnus-topic-mode-map
+ (setq gnus-topic-mode-map (make-sparse-keymap))
+
+ ;; Override certain group mode keys.
+ (gnus-define-keys gnus-topic-mode-map
+ "=" gnus-topic-select-group
+ "\r" gnus-topic-select-group
+ " " gnus-topic-read-group
+ "\C-k" gnus-topic-kill-group
+ "\C-y" gnus-topic-yank-group
+ "\M-g" gnus-topic-get-new-news-this-topic
+ "AT" gnus-topic-list-active
+ "Gp" gnus-topic-edit-parameters
+ "#" gnus-topic-mark-topic
+ "\M-#" gnus-topic-unmark-topic
+ gnus-mouse-2 gnus-mouse-pick-topic)
+
+ ;; Define a new submap.
+ (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map)
+ "#" gnus-topic-mark-topic
+ "\M-#" gnus-topic-unmark-topic
+ "n" gnus-topic-create-topic
+ "m" gnus-topic-move-group
+ "D" gnus-topic-remove-group
+ "c" gnus-topic-copy-group
+ "h" gnus-topic-hide-topic
+ "s" gnus-topic-show-topic
+ "M" gnus-topic-move-matching
+ "C" gnus-topic-copy-matching
+ "\C-i" gnus-topic-indent
+ [tab] gnus-topic-indent
+ "r" gnus-topic-rename
+ "\177" gnus-topic-delete
+ [delete] gnus-topic-delete
+ "h" gnus-topic-toggle-display-empty-topics)
+
+ (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map)
+ "s" gnus-topic-sort-groups
+ "a" gnus-topic-sort-groups-by-alphabet
+ "u" gnus-topic-sort-groups-by-unread
+ "l" gnus-topic-sort-groups-by-level
+ "v" gnus-topic-sort-groups-by-score
+ "r" gnus-topic-sort-groups-by-rank
+ "m" gnus-topic-sort-groups-by-method))
+
+(defun gnus-topic-make-menu-bar ()
+ (unless (boundp 'gnus-topic-menu)
+ (easy-menu-define
+ gnus-topic-menu gnus-topic-mode-map ""
+ '("Topics"
+ ["Toggle topics" gnus-topic-mode t]
+ ("Groups"
+ ["Copy" gnus-topic-copy-group t]
+ ["Move" gnus-topic-move-group t]
+ ["Remove" gnus-topic-remove-group t]
+ ["Copy matching" gnus-topic-copy-matching t]
+ ["Move matching" gnus-topic-move-matching t])
+ ("Topics"
+ ["Show" gnus-topic-show-topic t]
+ ["Hide" gnus-topic-hide-topic t]
+ ["Delete" gnus-topic-delete t]
+ ["Rename" gnus-topic-rename t]
+ ["Create" gnus-topic-create-topic t]
+ ["Mark" gnus-topic-mark-topic t]
+ ["Indent" gnus-topic-indent t]
+ ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t]
+ ["Edit parameters" gnus-topic-edit-parameters t])
+ ["List active" gnus-topic-list-active t]))))
+
+(defun gnus-topic-mode (&optional arg redisplay)
+ "Minor mode for topicsifying Gnus group buffers."
+ (interactive (list current-prefix-arg t))
+ (when (eq major-mode 'gnus-group-mode)
+ (make-local-variable 'gnus-topic-mode)
+ (setq gnus-topic-mode
+ (if (null arg) (not gnus-topic-mode)
+ (> (prefix-numeric-value arg) 0)))
+ ;; Infest Gnus with topics.
+ (if (not gnus-topic-mode)
+ (setq gnus-goto-missing-group-function nil)
+ (when (gnus-visual-p 'topic-menu 'menu)
+ (gnus-topic-make-menu-bar))
+ (gnus-set-format 'topic t)
+ (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map)
+ (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
+ (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
+ (set (make-local-variable 'gnus-group-prepare-function)
+ 'gnus-group-prepare-topics)
+ (set (make-local-variable 'gnus-group-get-parameter-function)
+ 'gnus-group-topic-parameters)
+ (set (make-local-variable 'gnus-group-goto-next-group-function)
+ 'gnus-topic-goto-next-group)
+ (set (make-local-variable 'gnus-group-indentation-function)
+ 'gnus-topic-group-indentation)
+ (set (make-local-variable 'gnus-group-update-group-function)
+ 'gnus-topic-update-topics-containing-group)
+ (set (make-local-variable 'gnus-group-sort-alist-function)
+ 'gnus-group-sort-topic)
+ (setq gnus-group-change-level-function 'gnus-topic-change-level)
+ (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
+ (make-local-hook 'gnus-check-bogus-groups-hook)
+ (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
+ (setq gnus-topology-checked-p nil)
+ ;; We check the topology.
+ (when gnus-newsrc-alist
+ (gnus-topic-check-topology))
+ (run-hooks 'gnus-topic-mode-hook))
+ ;; Remove topic infestation.
+ (unless gnus-topic-mode
+ (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
+ (remove-hook 'gnus-group-change-level-function
+ 'gnus-topic-change-level)
+ (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
+ (setq gnus-group-prepare-function 'gnus-group-prepare-flat)
+ (setq gnus-group-sort-alist-function 'gnus-group-sort-flat))
+ (when redisplay
+ (gnus-group-list-groups))))
+
+(defun gnus-topic-select-group (&optional all)
+ "Select this newsgroup.
+No article is selected automatically.
+If ALL is non-nil, already read articles become readable.
+If ALL is a number, fetch this number of articles.
+
+If performed over a topic line, toggle folding the topic."
+ (interactive "P")
+ (if (gnus-group-topic-p)
+ (let ((gnus-group-list-mode
+ (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
+ (gnus-topic-fold all))
+ (gnus-group-select-group all)))
+
+(defun gnus-mouse-pick-topic (e)
+ "Select the group or topic under the mouse pointer."
+ (interactive "e")
+ (mouse-set-point e)
+ (gnus-topic-read-group nil))
+
+(defun gnus-topic-read-group (&optional all no-article group)
+ "Read news in this newsgroup.
+If the prefix argument ALL is non-nil, already read articles become
+readable. IF ALL is a number, fetch this number of articles. If the
+optional argument NO-ARTICLE is non-nil, no article will be
+auto-selected upon group entry. If GROUP is non-nil, fetch that
+group.
+
+If performed over a topic line, toggle folding the topic."
+ (interactive "P")
+ (if (gnus-group-topic-p)
+ (let ((gnus-group-list-mode
+ (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
+ (gnus-topic-fold all))
+ (gnus-group-read-group all no-article group)))
+
+(defun gnus-topic-create-topic (topic parent &optional previous full-topic)
+ "Create a new TOPIC under PARENT.
+When used interactively, PARENT will be the topic under point."
+ (interactive
+ (list
+ (read-string "New topic: ")
+ (gnus-current-topic)))
+ ;; Check whether this topic already exists.
+ (when (gnus-topic-find-topology topic)
+ (error "Topic already exists"))
+ (unless parent
+ (setq parent (caar gnus-topic-topology)))
+ (let ((top (cdr (gnus-topic-find-topology parent)))
+ (full-topic (or full-topic `((,topic visible)))))
+ (unless top
+ (error "No such parent topic: %s" parent))
+ (if previous
+ (progn
+ (while (and (cdr top)
+ (not (equal (caaadr top) previous)))
+ (setq top (cdr top)))
+ (setcdr top (cons full-topic (cdr top))))
+ (nconc top (list full-topic)))
+ (unless (assoc topic gnus-topic-alist)
+ (push (list topic) gnus-topic-alist)))
+ (gnus-topic-enter-dribble)
+ (gnus-group-list-groups)
+ (gnus-topic-goto-topic topic))
+
+(defun gnus-topic-move-group (n topic &optional copyp)
+ "Move the next N groups to TOPIC.
+If COPYP, copy the groups instead."
+ (interactive
+ (list current-prefix-arg
+ (completing-read "Move to topic: " gnus-topic-alist nil t)))
+ (let ((groups (gnus-group-process-prefix n))
+ (topicl (assoc topic gnus-topic-alist))
+ (start-group (progn (forward-line 1) (gnus-group-group-name)))
+ (start-topic (gnus-group-topic-name))
+ entry)
+ (mapcar
+ (lambda (g)
+ (gnus-group-remove-mark g)
+ (when (and
+ (setq entry (assoc (gnus-current-topic) gnus-topic-alist))
+ (not copyp))
+ (setcdr entry (gnus-delete-first g (cdr entry))))
+ (nconc topicl (list g)))
+ groups)
+ (gnus-topic-enter-dribble)
+ (if start-group
+ (gnus-group-goto-group start-group)
+ (gnus-topic-goto-topic start-topic))
+ (gnus-group-list-groups)))
+
+(defun gnus-topic-remove-group (&optional arg)
+ "Remove the current group from the topic."
+ (interactive "P")
+ (gnus-group-iterate arg
+ (lambda (group)
+ (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
+ (buffer-read-only nil))
+ (when (and topicl group)
+ (gnus-delete-line)
+ (gnus-delete-first group topicl))
+ (gnus-topic-update-topic)
+ (gnus-group-position-point)))))
+
+(defun gnus-topic-copy-group (n topic)
+ "Copy the current group to a topic."
+ (interactive
+ (list current-prefix-arg
+ (completing-read "Copy to topic: " gnus-topic-alist nil t)))
+ (gnus-topic-move-group n topic t))
+
+(defun gnus-topic-kill-group (&optional n discard)
+ "Kill the next N groups."
+ (interactive "P")
+ (if (gnus-group-topic-p)
+ (let ((topic (gnus-group-topic-name)))
+ (push (cons
+ (gnus-topic-find-topology topic)
+ (assoc topic gnus-topic-alist))
+ gnus-topic-killed-topics)
+ (gnus-topic-remove-topic nil t)
+ (gnus-topic-find-topology topic nil nil gnus-topic-topology)
+ (gnus-topic-enter-dribble))
+ (gnus-group-kill-group n discard)
+ (gnus-topic-update-topic)))
+
+(defun gnus-topic-yank-group (&optional arg)
+ "Yank the last topic."
+ (interactive "p")
+ (if gnus-topic-killed-topics
+ (let* ((previous
+ (or (gnus-group-topic-name)
+ (gnus-topic-next-topic (gnus-current-topic))))
+ (data (pop gnus-topic-killed-topics))
+ (alist (cdr data))
+ (item (cdar data)))
+ (push alist gnus-topic-alist)
+ (gnus-topic-create-topic
+ (caar item) (gnus-topic-parent-topic previous) previous
+ item)
+ (gnus-topic-enter-dribble)
+ (gnus-topic-goto-topic (caar item)))
+ (let* ((prev (gnus-group-group-name))
+ (gnus-topic-inhibit-change-level t)
+ (gnus-group-indentation
+ (make-string
+ (* gnus-topic-indent-level
+ (or (save-excursion
+ (gnus-topic-goto-topic (gnus-current-topic))
+ (gnus-group-topic-level))
+ 0))
+ ? ))
+ yanked alist)
+ ;; We first yank the groups the normal way...
+ (setq yanked (gnus-group-yank-group arg))
+ ;; Then we enter the yanked groups into the topics they belong
+ ;; to.
+ (setq alist (assoc (save-excursion
+ (forward-line -1)
+ (gnus-current-topic))
+ gnus-topic-alist))
+ (when (stringp yanked)
+ (setq yanked (list yanked)))
+ (if (not prev)
+ (nconc alist yanked)
+ (if (not (cdr alist))
+ (setcdr alist (nconc yanked (cdr alist)))
+ (while (cdr alist)
+ (when (equal (cadr alist) prev)
+ (setcdr alist (nconc yanked (cdr alist)))
+ (setq alist nil))
+ (setq alist (cdr alist))))))
+ (gnus-topic-update-topic)))
+
+(defun gnus-topic-hide-topic ()
+ "Hide the current topic."
+ (interactive)
+ (when (gnus-current-topic)
+ (gnus-topic-goto-topic (gnus-current-topic))
+ (gnus-topic-remove-topic nil nil 'hidden)))
+
+(defun gnus-topic-show-topic ()
+ "Show the hidden topic."
+ (interactive)
+ (when (gnus-group-topic-p)
+ (gnus-topic-remove-topic t nil 'shown)))
+
+(defun gnus-topic-mark-topic (topic &optional unmark)
+ "Mark all groups in the topic with the process mark."
+ (interactive (list (gnus-group-topic-name)))
+ (if (not topic)
+ (call-interactively 'gnus-group-mark-group)
+ (save-excursion
+ (let ((groups (gnus-topic-find-groups topic 9 t)))
+ (while groups
+ (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
+ (gnus-info-group (nth 2 (pop groups)))))))))
+
+(defun gnus-topic-unmark-topic (topic &optional unmark)
+ "Remove the process mark from all groups in the topic."
+ (interactive (list (gnus-group-topic-name)))
+ (if (not topic)
+ (call-interactively 'gnus-group-unmark-group)
+ (gnus-topic-mark-topic topic t)))
+
+(defun gnus-topic-get-new-news-this-topic (&optional n)
+ "Check for new news in the current topic."
+ (interactive "P")
+ (if (not (gnus-group-topic-p))
+ (gnus-group-get-new-news-this-group n)
+ (gnus-topic-mark-topic (gnus-group-topic-name))
+ (gnus-group-get-new-news-this-group)))
+
+(defun gnus-topic-move-matching (regexp topic &optional copyp)
+ "Move all groups that match REGEXP to some topic."
+ (interactive
+ (let (topic)
+ (nreverse
+ (list
+ (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t))
+ (read-string (format "Move to %s (regexp): " topic))))))
+ (gnus-group-mark-regexp regexp)
+ (gnus-topic-move-group nil topic copyp))
+
+(defun gnus-topic-copy-matching (regexp topic &optional copyp)
+ "Copy all groups that match REGEXP to some topic."
+ (interactive
+ (let (topic)
+ (nreverse
+ (list
+ (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t))
+ (read-string (format "Copy to %s (regexp): " topic))))))
+ (gnus-topic-move-matching regexp topic t))
+
+(defun gnus-topic-delete (topic)
+ "Delete a topic."
+ (interactive (list (gnus-group-topic-name)))
+ (unless topic
+ (error "No topic to be deleted"))
+ (let ((entry (assoc topic gnus-topic-alist))
+ (buffer-read-only nil))
+ (when (cdr entry)
+ (error "Topic not empty"))
+ ;; Delete if visible.
+ (when (gnus-topic-goto-topic topic)
+ (gnus-delete-line))
+ ;; Remove from alist.
+ (setq gnus-topic-alist (delq entry gnus-topic-alist))
+ ;; Remove from topology.
+ (gnus-topic-find-topology topic nil nil 'delete)
+ (gnus-dribble-touch)))
+
+(defun gnus-topic-rename (old-name new-name)
+ "Rename a topic."
+ (interactive
+ (let ((topic (gnus-current-topic)))
+ (list topic
+ (read-string (format "Rename %s to: " topic)))))
+ (let ((top (gnus-topic-find-topology old-name))
+ (entry (assoc old-name gnus-topic-alist)))
+ (when top
+ (setcar (cadr top) new-name))
+ (when entry
+ (setcar entry new-name))
+ (forward-line -1)
+ (gnus-dribble-touch)
+ (gnus-group-list-groups)))
+
+(defun gnus-topic-indent (&optional unindent)
+ "Indent a topic -- make it a sub-topic of the previous topic.
+If UNINDENT, remove an indentation."
+ (interactive "P")
+ (if unindent
+ (gnus-topic-unindent)
+ (let* ((topic (gnus-current-topic))
+ (parent (gnus-topic-previous-topic topic))
+ (buffer-read-only nil))
+ (unless parent
+ (error "Nothing to indent %s into" topic))
+ (when topic
+ (gnus-topic-goto-topic topic)
+ (gnus-topic-kill-group)
+ (push (cdar gnus-topic-killed-topics) gnus-topic-alist)
+ (gnus-topic-create-topic
+ topic parent nil (cdaar gnus-topic-killed-topics))
+ (pop gnus-topic-killed-topics)
+ (or (gnus-topic-goto-topic topic)
+ (gnus-topic-goto-topic parent))))))
+
+(defun gnus-topic-unindent ()
+ "Unindent a topic."
+ (interactive)
+ (let* ((topic (gnus-current-topic))
+ (parent (gnus-topic-parent-topic topic))
+ (grandparent (gnus-topic-parent-topic parent)))
+ (unless grandparent
+ (error "Nothing to indent %s into" topic))
+ (when topic
+ (gnus-topic-goto-topic topic)
+ (gnus-topic-kill-group)
+ (push (cdar gnus-topic-killed-topics) gnus-topic-alist)
+ (gnus-topic-create-topic
+ topic grandparent (gnus-topic-next-topic parent)
+ (cdaar gnus-topic-killed-topics))
+ (pop gnus-topic-killed-topics)
+ (gnus-topic-goto-topic topic))))
+
+(defun gnus-topic-list-active (&optional force)
+ "List all groups that Gnus knows about in a topicsified fashion.
+If FORCE, always re-read the active file."
+ (interactive "P")
+ (when force
+ (gnus-get-killed-groups))
+ (gnus-topic-grok-active force)
+ (let ((gnus-topic-topology gnus-topic-active-topology)
+ (gnus-topic-alist gnus-topic-active-alist)
+ gnus-killed-list gnus-zombie-list)
+ (gnus-group-list-groups 9 nil 1)))
+
+(defun gnus-topic-toggle-display-empty-topics ()
+ "Show/hide topics that have no unread articles."
+ (interactive)
+ (setq gnus-topic-display-empty-topics
+ (not gnus-topic-display-empty-topics))
+ (gnus-group-list-groups)
+ (message "%s empty topics"
+ (if gnus-topic-display-empty-topics
+ "Showing" "Hiding")))
+
+;;; Topic sorting functions
+
+(defun gnus-topic-edit-parameters (group)
+ "Edit the group parameters of GROUP.
+If performed on a topic, edit the topic parameters instead."
+ (interactive (list (gnus-group-group-name)))
+ (if group
+ (gnus-group-edit-group-parameters group)
+ (if (not (gnus-group-topic-p))
+ (error "Nothing to edit on the current line")
+ (let ((topic (gnus-group-topic-name)))
+ (gnus-edit-form
+ (gnus-topic-parameters topic)
+ (format "Editing the topic parameters for `%s'."
+ (or group topic))
+ `(lambda (form)
+ (gnus-topic-set-parameters ,topic form)))))))
+
+(defun gnus-group-sort-topic (func reverse)
+ "Sort groups in the topics according to FUNC and REVERSE."
+ (let ((alist gnus-topic-alist))
+ (while alist
+ ;; !!!Sometimes nil elements sneak into the alist,
+ ;; for some reason or other.
+ (setcar alist (delq nil (car alist)))
+ (setcar alist (delete "dummy.group" (car alist)))
+ (gnus-topic-sort-topic (pop alist) func reverse))))
+
+(defun gnus-topic-sort-topic (topic func reverse)
+ ;; Each topic only lists the name of the group, while
+ ;; the sort predicates expect group infos as inputs.
+ ;; So we first transform the group names into infos,
+ ;; then sort, and then transform back into group names.
+ (setcdr
+ topic
+ (mapcar
+ (lambda (info) (gnus-info-group info))
+ (sort
+ (mapcar
+ (lambda (group) (gnus-get-info group))
+ (cdr topic))
+ func)))
+ ;; Do the reversal, if necessary.
+ (when reverse
+ (setcdr topic (nreverse (cdr topic)))))
+
+(defun gnus-topic-sort-groups (func &optional reverse)
+ "Sort the current topic according to FUNC.
+If REVERSE, reverse the sorting order."
+ (interactive (list gnus-group-sort-function current-prefix-arg))
+ (let ((topic (assoc (gnus-current-topic) gnus-topic-alist)))
+ (gnus-topic-sort-topic
+ topic (gnus-make-sort-function func) reverse)
+ (gnus-group-list-groups)))
+
+(defun gnus-topic-sort-groups-by-alphabet (&optional reverse)
+ "Sort the current topic alphabetically by group name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse))
+
+(defun gnus-topic-sort-groups-by-unread (&optional reverse)
+ "Sort the current topic by number of unread articles.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse))
+
+(defun gnus-topic-sort-groups-by-level (&optional reverse)
+ "Sort the current topic by group level.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-level reverse))
+
+(defun gnus-topic-sort-groups-by-score (&optional reverse)
+ "Sort the current topic by group score.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-score reverse))
+
+(defun gnus-topic-sort-groups-by-rank (&optional reverse)
+ "Sort the current topic by group rank.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse))
+
+(defun gnus-topic-sort-groups-by-method (&optional reverse)
+ "Sort the current topic alphabetically by backend name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse))
+
+(provide 'gnus-topic)
+
+;;; gnus-topic.el ends here
--- /dev/null
+;;; gnus-undo.el --- minor mode for undoing in Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package allows arbitrary undoing in Gnus buffers. As all the
+;; Gnus buffers aren't very text-oriented (what is in the buffers is
+;; just some random representation of the actual data), normal Emacs
+;; undoing doesn't work at all for Gnus.
+;;
+;; This package works by letting Gnus register functions for reversing
+;; actions, and then calling these functions when the user pushes the
+;; `undo' key. As with normal `undo', there it is possible to set
+;; undo boundaries and so on.
+;;
+;; Internally, the undo sequence is represented by the
+;; `gnus-undo-actions' list, where each element is a list of functions
+;; to be called, in sequence, to undo some action. (An "action" is a
+;; collection of functions.)
+;;
+;; For instance, a function for killing a group will call
+;; `gnus-undo-register' with a function that un-kills the group. This
+;; package will put that function into an action.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus-util)
+(require 'gnus)
+
+(defvar gnus-undo-mode nil
+ "Minor mode for undoing in Gnus buffers.")
+
+(defvar gnus-undo-mode-hook nil
+ "Hook called in all `gnus-undo-mode' buffers.")
+
+;;; Internal variables.
+
+(defvar gnus-undo-actions nil)
+(defvar gnus-undo-boundary t)
+(defvar gnus-undo-last nil)
+(defvar gnus-undo-boundary-inhibit nil)
+
+;;; Minor mode definition.
+
+(defvar gnus-undo-mode-map nil)
+
+(unless gnus-undo-mode-map
+ (setq gnus-undo-mode-map (make-sparse-keymap))
+
+ (gnus-define-keys gnus-undo-mode-map
+ "\M-\C-_" gnus-undo
+ "\C-_" gnus-undo
+ "\C-xu" gnus-undo
+ ;; many people are used to type `C-/' on X terminals and get `C-_'.
+ [(control /)] gnus-undo))
+
+(defun gnus-undo-make-menu-bar ()
+ ;; This is disabled for the time being.
+ (when nil
+ (define-key-after (current-local-map) [menu-bar file gnus-undo]
+ (cons "Undo" 'gnus-undo-actions)
+ [menu-bar file whatever])))
+
+(defun gnus-undo-mode (&optional arg)
+ "Minor mode for providing `undo' in Gnus buffers.
+
+\\{gnus-undo-mode-map}"
+ (interactive "P")
+ (set (make-local-variable 'gnus-undo-mode)
+ (if (null arg) (not gnus-undo-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (set (make-local-variable 'gnus-undo-actions) nil)
+ (set (make-local-variable 'gnus-undo-boundary) t)
+ (when gnus-undo-mode
+ ;; Set up the menu.
+ (when (gnus-visual-p 'undo-menu 'menu)
+ (gnus-undo-make-menu-bar))
+ (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map)
+ (make-local-hook 'post-command-hook)
+ (add-hook 'post-command-hook 'gnus-undo-boundary nil t)
+ (run-hooks 'gnus-undo-mode-hook)))
+
+;;; Interface functions.
+
+(defun gnus-disable-undo (&optional buffer)
+ "Disable undoing in the current buffer."
+ (interactive)
+ (save-excursion
+ (when buffer
+ (set-buffer buffer))
+ (gnus-undo-mode -1)))
+
+(defun gnus-undo-boundary ()
+ "Set Gnus undo boundary."
+ (if gnus-undo-boundary-inhibit
+ (setq gnus-undo-boundary-inhibit nil)
+ (setq gnus-undo-boundary t)))
+
+(defun gnus-undo-force-boundary ()
+ "Set Gnus undo boundary."
+ (setq gnus-undo-boundary-inhibit nil
+ gnus-undo-boundary t))
+
+(defun gnus-undo-register (form)
+ "Register FORMS as something to be performed to undo a change.
+FORMS may use backtick quote syntax."
+ (when gnus-undo-mode
+ (gnus-undo-register-1
+ `(lambda ()
+ ,form))))
+
+(put 'gnus-undo-register 'lisp-indent-function 0)
+(put 'gnus-undo-register 'edebug-form-spec '(body))
+
+(defun gnus-undo-register-1 (function)
+ "Register FUNCTION as something to be performed to undo a change."
+ (when gnus-undo-mode
+ (cond
+ ;; We are on a boundary, so we create a new action.
+ (gnus-undo-boundary
+ (push (list function) gnus-undo-actions)
+ (setq gnus-undo-boundary nil))
+ ;; Prepend the function to an old action.
+ (gnus-undo-actions
+ (setcar gnus-undo-actions (cons function (car gnus-undo-actions))))
+ ;; Initialize list.
+ (t
+ (setq gnus-undo-actions (list (list function)))))
+ (setq gnus-undo-boundary-inhibit t)))
+
+(defun gnus-undo (n)
+ "Undo some previous changes in Gnus buffers.
+Repeat this command to undo more changes.
+A numeric argument serves as a repeat count."
+ (interactive "p")
+ (unless gnus-undo-mode
+ (error "Undoing is not enabled in this buffer"))
+ (message "%s" last-command)
+ (when (or (not (eq last-command 'gnus-undo))
+ (not gnus-undo-last))
+ (setq gnus-undo-last gnus-undo-actions))
+ (let ((action (pop gnus-undo-last)))
+ (unless action
+ (error "Nothing further to undo"))
+ (setq gnus-undo-actions (delq action gnus-undo-actions))
+ (setq gnus-undo-boundary t)
+ (while action
+ (funcall (pop action)))))
+
+(provide 'gnus-undo)
+
+;;; gnus-undo.el ends here
--- /dev/null
+;;; gnus-util.el --- utility functions for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Nothing in this file depends on any other parts of Gnus -- all
+;; functions and macros in this file are utility functions that are
+;; used by Gnus and may be used by any other package without loading
+;; Gnus first.
+
+;;; Code:
+
+(require 'custom)
+(eval-when-compile (require 'cl))
+(require 'nnheader)
+(require 'timezone)
+(require 'message)
+
+(eval-and-compile
+ (autoload 'nnmail-date-to-time "nnmail"))
+
+(defun gnus-boundp (variable)
+ "Return non-nil if VARIABLE is bound and non-nil."
+ (and (boundp variable)
+ (symbol-value variable)))
+
+(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
+ "Pop to BUFFER, evaluate FORMS, and then return to the original window."
+ (let ((tempvar (make-symbol "GnusStartBufferWindow"))
+ (w (make-symbol "w"))
+ (buf (make-symbol "buf")))
+ `(let* ((,tempvar (selected-window))
+ (,buf ,buffer)
+ (,w (get-buffer-window ,buf 'visible)))
+ (unwind-protect
+ (progn
+ (if ,w
+ (progn
+ (select-window ,w)
+ (set-buffer (window-buffer ,w)))
+ (pop-to-buffer ,buf))
+ ,@forms)
+ (select-window ,tempvar)))))
+
+(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
+(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
+
+(defmacro gnus-intern-safe (string hashtable)
+ "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
+ `(let ((symbol (intern ,string ,hashtable)))
+ (or (boundp symbol)
+ (set symbol nil))
+ symbol))
+
+;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; function `substring' might cut on a middle of multi-octet
+;; character.
+(defun gnus-truncate-string (str width)
+ (substring str 0 width))
+
+;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way
+;; to limit the length of a string. This function is necessary since
+;; `(substr "abc" 0 30)' pukes with "Args out of range".
+(defsubst gnus-limit-string (str width)
+ (if (> (length str) width)
+ (substring str 0 width)
+ str))
+
+(defsubst gnus-functionp (form)
+ "Return non-nil if FORM is funcallable."
+ (or (and (symbolp form) (fboundp form))
+ (and (listp form) (eq (car form) 'lambda))
+ (byte-code-function-p form)))
+
+(defsubst gnus-goto-char (point)
+ (and point (goto-char point)))
+
+(defmacro gnus-buffer-exists-p (buffer)
+ `(let ((buffer ,buffer))
+ (when buffer
+ (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
+ buffer))))
+
+(defmacro gnus-kill-buffer (buffer)
+ `(let ((buf ,buffer))
+ (when (gnus-buffer-exists-p buf)
+ (kill-buffer buf))))
+
+(if (fboundp 'point-at-bol)
+ (fset 'gnus-point-at-bol 'point-at-bol)
+ (defun gnus-point-at-bol ()
+ "Return point at the beginning of the line."
+ (let ((p (point)))
+ (beginning-of-line)
+ (prog1
+ (point)
+ (goto-char p)))))
+
+(if (fboundp 'point-at-eol)
+ (fset 'gnus-point-at-eol 'point-at-eol)
+ (defun gnus-point-at-eol ()
+ "Return point at the end of the line."
+ (let ((p (point)))
+ (end-of-line)
+ (prog1
+ (point)
+ (goto-char p)))))
+
+(defun gnus-delete-first (elt list)
+ "Delete by side effect the first occurrence of ELT as a member of LIST."
+ (if (equal (car list) elt)
+ (cdr list)
+ (let ((total list))
+ (while (and (cdr list)
+ (not (equal (cadr list) elt)))
+ (setq list (cdr list)))
+ (when (cdr list)
+ (setcdr list (cddr list)))
+ total)))
+
+;; Delete the current line (and the next N lines).
+(defmacro gnus-delete-line (&optional n)
+ `(delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line ,(or n 1)) (point))))
+
+(defun gnus-byte-code (func)
+ "Return a form that can be `eval'ed based on FUNC."
+ (let ((fval (symbol-function func)))
+ (if (byte-code-function-p fval)
+ (let ((flist (append fval nil)))
+ (setcar flist 'byte-code)
+ flist)
+ (cons 'progn (cddr fval)))))
+
+(defun gnus-extract-address-components (from)
+ (let (name address)
+ ;; First find the address - the thing with the @ in it. This may
+ ;; not be accurate in mail addresses, but does the trick most of
+ ;; the time in news messages.
+ (when (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
+ (setq address (substring from (match-beginning 0) (match-end 0))))
+ ;; Then we check whether the "name <address>" format is used.
+ (and address
+ ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ ;; Linear white space is not required.
+ (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
+ (and (setq name (substring from 0 (match-beginning 0)))
+ ;; Strip any quotes from the name.
+ (string-match "\".*\"" name)
+ (setq name (substring name 1 (1- (match-end 0))))))
+ ;; If not, then "address (name)" is used.
+ (or name
+ (and (string-match "(.+)" from)
+ (setq name (substring from (1+ (match-beginning 0))
+ (1- (match-end 0)))))
+ (and (string-match "()" from)
+ (setq name address))
+ ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
+ ;; XOVER might not support folded From headers.
+ (and (string-match "(.*" from)
+ (setq name (substring from (1+ (match-beginning 0))
+ (match-end 0)))))
+ ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
+ (list (or name from) (or address from))))
+
+(defun gnus-fetch-field (field)
+ "Return the value of the header FIELD of current article."
+ (save-excursion
+ (save-restriction
+ (let ((case-fold-search t)
+ (inhibit-point-motion-hooks t))
+ (nnheader-narrow-to-headers)
+ (message-fetch-field field)))))
+
+(defun gnus-goto-colon ()
+ (beginning-of-line)
+ (search-forward ":" (gnus-point-at-eol) t))
+
+(defun gnus-remove-text-with-property (prop)
+ "Delete all text in the current buffer with text property PROP."
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (while (get-text-property (point) prop)
+ (delete-char 1))
+ (goto-char (next-single-property-change (point) prop nil (point-max))))))
+
+(defun gnus-newsgroup-directory-form (newsgroup)
+ "Make hierarchical directory name from NEWSGROUP name."
+ (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
+ (len (length newsgroup))
+ idx)
+ ;; If this is a foreign group, we don't want to translate the
+ ;; entire name.
+ (if (setq idx (string-match ":" newsgroup))
+ (aset newsgroup idx ?/)
+ (setq idx 0))
+ ;; Replace all occurrences of `.' with `/'.
+ (while (< idx len)
+ (when (= (aref newsgroup idx) ?.)
+ (aset newsgroup idx ?/))
+ (setq idx (1+ idx)))
+ newsgroup))
+
+(defun gnus-newsgroup-savable-name (group)
+ ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
+ ;; with dots.
+ (nnheader-replace-chars-in-string group ?/ ?.))
+
+(defun gnus-string> (s1 s2)
+ (not (or (string< s1 s2)
+ (string= s1 s2))))
+
+;;; Time functions.
+
+(defun gnus-days-between (date1 date2)
+ ;; Return the number of days between date1 and date2.
+ (- (gnus-day-number date1) (gnus-day-number date2)))
+
+(defun gnus-day-number (date)
+ (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
+ (timezone-parse-date date))))
+ (timezone-absolute-from-gregorian
+ (nth 1 dat) (nth 2 dat) (car dat))))
+
+(defun gnus-time-to-day (time)
+ "Convert TIME to day number."
+ (let ((tim (decode-time time)))
+ (timezone-absolute-from-gregorian
+ (nth 4 tim) (nth 3 tim) (nth 5 tim))))
+
+(defun gnus-encode-date (date)
+ "Convert DATE to internal time."
+ (let* ((parse (timezone-parse-date date))
+ (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
+ (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
+ (encode-time (caddr time) (cadr time) (car time)
+ (caddr date) (cadr date) (car date)
+ (* 60 (timezone-zone-to-minute (nth 4 date))))))
+
+(defun gnus-time-minus (t1 t2)
+ "Subtract two internal times."
+ (let ((borrow (< (cadr t1) (cadr t2))))
+ (list (- (car t1) (car t2) (if borrow 1 0))
+ (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
+
+(defun gnus-time-less (t1 t2)
+ "Say whether time T1 is less than time T2."
+ (or (< (car t1) (car t2))
+ (and (= (car t1) (car t2))
+ (< (nth 1 t1) (nth 1 t2)))))
+
+(defun gnus-file-newer-than (file date)
+ (let ((fdate (nth 5 (file-attributes file))))
+ (or (> (car fdate) (car date))
+ (and (= (car fdate) (car date))
+ (> (nth 1 fdate) (nth 1 date))))))
+
+;;; Keymap macros.
+
+(defmacro gnus-local-set-keys (&rest plist)
+ "Set the keys in PLIST in the current keymap."
+ `(gnus-define-keys-1 (current-local-map) ',plist))
+
+(defmacro gnus-define-keys (keymap &rest plist)
+ "Define all keys in PLIST in KEYMAP."
+ `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
+
+(defmacro gnus-define-keys-safe (keymap &rest plist)
+ "Define all keys in PLIST in KEYMAP without overwriting previous definitions."
+ `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
+
+(put 'gnus-define-keys 'lisp-indent-function 1)
+(put 'gnus-define-keys-safe 'lisp-indent-function 1)
+(put 'gnus-local-set-keys 'lisp-indent-function 1)
+
+(defmacro gnus-define-keymap (keymap &rest plist)
+ "Define all keys in PLIST in KEYMAP."
+ `(gnus-define-keys-1 ,keymap (quote ,plist)))
+
+(put 'gnus-define-keymap 'lisp-indent-function 1)
+
+(defun gnus-define-keys-1 (keymap plist &optional safe)
+ (when (null keymap)
+ (error "Can't set keys in a null keymap"))
+ (cond ((symbolp keymap)
+ (setq keymap (symbol-value keymap)))
+ ((keymapp keymap))
+ ((listp keymap)
+ (set (car keymap) nil)
+ (define-prefix-command (car keymap))
+ (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
+ (setq keymap (symbol-value (car keymap)))))
+ (let (key)
+ (while plist
+ (when (symbolp (setq key (pop plist)))
+ (setq key (symbol-value key)))
+ (if (or (not safe)
+ (eq (lookup-key keymap key) 'undefined))
+ (define-key keymap key (pop plist))
+ (pop plist)))))
+
+(defun gnus-completing-read (default prompt &rest args)
+ ;; Like `completing-read', except that DEFAULT is the default argument.
+ (let* ((prompt (if default
+ (concat prompt " (default " default ") ")
+ (concat prompt " ")))
+ (answer (apply 'completing-read prompt args)))
+ (if (or (null answer) (zerop (length answer)))
+ default
+ answer)))
+
+;; Two silly functions to ensure that all `y-or-n-p' questions clear
+;; the echo area.
+(defun gnus-y-or-n-p (prompt)
+ (prog1
+ (y-or-n-p prompt)
+ (message "")))
+
+(defun gnus-yes-or-no-p (prompt)
+ (prog1
+ (yes-or-no-p prompt)
+ (message "")))
+
+;; I suspect there's a better way, but I haven't taken the time to do
+;; it yet. -erik selberg@cs.washington.edu
+(defun gnus-dd-mmm (messy-date)
+ "Return a string like DD-MMM from a big messy string"
+ (let ((datevec (ignore-errors (timezone-parse-date messy-date))))
+ (if (not datevec)
+ "??-???"
+ (format "%2s-%s"
+ (condition-case ()
+ ;; Make sure leading zeroes are stripped.
+ (number-to-string (string-to-number (aref datevec 2)))
+ (error "??"))
+ (capitalize
+ (or (car
+ (nth (1- (string-to-number (aref datevec 1)))
+ timezone-months-assoc))
+ "???"))))))
+
+(defmacro gnus-date-get-time (date)
+ "Convert DATE string to Emacs time.
+Cache the result as a text property stored in DATE."
+ ;; Either return the cached value...
+ `(let ((d ,date))
+ (if (equal "" d)
+ '(0 0)
+ (or (get-text-property 0 'gnus-time d)
+ ;; or compute the value...
+ (let ((time (nnmail-date-to-time d)))
+ ;; and store it back in the string.
+ (put-text-property 0 1 'gnus-time time d)
+ time)))))
+
+(defsubst gnus-time-iso8601 (time)
+ "Return a string of TIME in YYMMDDTHHMMSS format."
+ (format-time-string "%Y%m%dT%H%M%S" time))
+
+(defun gnus-date-iso8601 (header)
+ "Convert the date field in HEADER to YYMMDDTHHMMSS"
+ (condition-case ()
+ (gnus-time-iso8601 (gnus-date-get-time header))
+ (error "")))
+
+(defun gnus-mode-string-quote (string)
+ "Quote all \"%\"'s in STRING."
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert string)
+ (goto-char (point-min))
+ (while (search-forward "%" nil t)
+ (insert "%"))
+ (buffer-string)))
+
+;; Make a hash table (default and minimum size is 256).
+;; Optional argument HASHSIZE specifies the table size.
+(defun gnus-make-hashtable (&optional hashsize)
+ (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 256) 256) 0))
+
+;; Make a number that is suitable for hashing; bigger than MIN and
+;; equal to some 2^x. Many machines (such as sparcs) do not have a
+;; hardware modulo operation, so they implement it in software. On
+;; many sparcs over 50% of the time to intern is spent in the modulo.
+;; Yes, it's slower than actually computing the hash from the string!
+;; So we use powers of 2 so people can optimize the modulo to a mask.
+(defun gnus-create-hash-size (min)
+ (let ((i 1))
+ (while (< i min)
+ (setq i (* 2 i)))
+ i))
+
+(defcustom gnus-verbose 7
+ "*Integer that says how verbose Gnus should be.
+The higher the number, the more messages Gnus will flash to say what
+it's doing. At zero, Gnus will be totally mute; at five, Gnus will
+display most important messages; and at ten, Gnus will keep on
+jabbering all the time."
+ :group 'gnus-start
+ :type 'integer)
+
+;; Show message if message has a lower level than `gnus-verbose'.
+;; Guideline for numbers:
+;; 1 - error messages, 3 - non-serious error messages, 5 - messages
+;; for things that take a long time, 7 - not very important messages
+;; on stuff, 9 - messages inside loops.
+(defun gnus-message (level &rest args)
+ (if (<= level gnus-verbose)
+ (apply 'message args)
+ ;; We have to do this format thingy here even if the result isn't
+ ;; shown - the return value has to be the same as the return value
+ ;; from `message'.
+ (apply 'format args)))
+
+(defun gnus-error (level &rest args)
+ "Beep an error if LEVEL is equal to or less than `gnus-verbose'."
+ (when (<= (floor level) gnus-verbose)
+ (apply 'message args)
+ (ding)
+ (let (duration)
+ (when (and (floatp level)
+ (not (zerop (setq duration (* 10 (- level (floor level)))))))
+ (sit-for duration))))
+ nil)
+
+(defun gnus-split-references (references)
+ "Return a list of Message-IDs in REFERENCES."
+ (let ((beg 0)
+ ids)
+ (while (string-match "<[^>]+>" references beg)
+ (push (substring references (match-beginning 0) (setq beg (match-end 0)))
+ ids))
+ (nreverse ids)))
+
+(defun gnus-parent-id (references &optional n)
+ "Return the last Message-ID in REFERENCES.
+If N, return the Nth ancestor instead."
+ (when references
+ (let ((ids (inline (gnus-split-references references))))
+ (while (nthcdr (or n 1) ids)
+ (setq ids (cdr ids)))
+ (car ids))))
+
+(defsubst gnus-buffer-live-p (buffer)
+ "Say whether BUFFER is alive or not."
+ (and buffer
+ (get-buffer buffer)
+ (buffer-name (get-buffer buffer))))
+
+(defun gnus-horizontal-recenter ()
+ "Recenter the current buffer horizontally."
+ (if (< (current-column) (/ (window-width) 2))
+ (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
+ (let* ((orig (point))
+ (end (window-end (get-buffer-window (current-buffer) t)))
+ (max 0))
+ ;; Find the longest line currently displayed in the window.
+ (goto-char (window-start))
+ (while (and (not (eobp))
+ (< (point) end))
+ (end-of-line)
+ (setq max (max max (current-column)))
+ (forward-line 1))
+ (goto-char orig)
+ ;; Scroll horizontally to center (sort of) the point.
+ (if (> max (window-width))
+ (set-window-hscroll
+ (get-buffer-window (current-buffer) t)
+ (min (- (current-column) (/ (window-width) 3))
+ (+ 2 (- max (window-width)))))
+ (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
+ max)))
+
+(defun gnus-read-event-char ()
+ "Get the next event."
+ (let ((event (read-event)))
+ ;; should be gnus-characterp, but this can't be called in XEmacs anyway
+ (cons (and (numberp event) event) event)))
+
+(defun gnus-sortable-date (date)
+ "Make sortable string by string-lessp from DATE.
+Timezone package is used."
+ (condition-case ()
+ (progn
+ (setq date (inline (timezone-fix-time
+ date nil
+ (aref (inline (timezone-parse-date date)) 4))))
+ (inline
+ (timezone-make-sortable-date
+ (aref date 0) (aref date 1) (aref date 2)
+ (inline
+ (timezone-make-time-string
+ (aref date 3) (aref date 4) (aref date 5))))))
+ (error "")))
+
+(defun gnus-copy-file (file &optional to)
+ "Copy FILE to TO."
+ (interactive
+ (list (read-file-name "Copy file: " default-directory)
+ (read-file-name "Copy file to: " default-directory)))
+ (unless to
+ (setq to (read-file-name "Copy file to: " default-directory)))
+ (when (file-directory-p to)
+ (setq to (concat (file-name-as-directory to)
+ (file-name-nondirectory file))))
+ (copy-file file to))
+
+(defun gnus-kill-all-overlays ()
+ "Delete all overlays in the current buffer."
+ (unless gnus-xemacs
+ (let* ((overlayss (overlay-lists))
+ (buffer-read-only nil)
+ (overlays (delq nil (nconc (car overlayss) (cdr overlayss)))))
+ (while overlays
+ (delete-overlay (pop overlays))))))
+
+(defvar gnus-work-buffer " *gnus work*")
+
+(defun gnus-set-work-buffer ()
+ "Put point in the empty Gnus work buffer."
+ (if (get-buffer gnus-work-buffer)
+ (progn
+ (set-buffer gnus-work-buffer)
+ (erase-buffer))
+ (set-buffer (get-buffer-create gnus-work-buffer))
+ (kill-all-local-variables)
+ (buffer-disable-undo (current-buffer))))
+
+(defmacro gnus-group-real-name (group)
+ "Find the real name of a foreign newsgroup."
+ `(let ((gname ,group))
+ (if (string-match "^[^:]+:" gname)
+ (substring gname (match-end 0))
+ gname)))
+
+(defun gnus-make-sort-function (funs)
+ "Return a composite sort condition based on the functions in FUNC."
+ (cond
+ ((not (listp funs)) funs)
+ ((null funs) funs)
+ ((cdr funs)
+ `(lambda (t1 t2)
+ ,(gnus-make-sort-function-1 (reverse funs))))
+ (t
+ (car funs))))
+
+(defun gnus-make-sort-function-1 (funs)
+ "Return a composite sort condition based on the functions in FUNC."
+ (if (cdr funs)
+ `(or (,(car funs) t1 t2)
+ (and (not (,(car funs) t2 t1))
+ ,(gnus-make-sort-function-1 (cdr funs))))
+ `(,(car funs) t1 t2)))
+
+(defun gnus-turn-off-edit-menu (type)
+ "Turn off edit menu in `gnus-TYPE-mode-map'."
+ (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
+ [menu-bar edit] 'undefined))
+
+(defun gnus-prin1 (form)
+ "Use `prin1' on FORM in the current buffer.
+Bind `print-quoted' to t while printing."
+ (let ((print-quoted t)
+ print-level print-length)
+ (prin1 form (current-buffer))))
+
+(defun gnus-prin1-to-string (form)
+ "The same as `prin1', but but `print-quoted' to t."
+ (let ((print-quoted t))
+ (prin1-to-string form)))
+
+(defun gnus-make-directory (directory)
+ "Make DIRECTORY (and all its parents) if it doesn't exist."
+ (when (and directory
+ (not (file-exists-p directory)))
+ (make-directory directory t))
+ t)
+
+(defun gnus-write-buffer (file)
+ "Write the current buffer's contents to FILE."
+ ;; Make sure the directory exists.
+ (gnus-make-directory (file-name-directory file))
+ ;; Write the buffer.
+ (write-region (point-min) (point-max) file nil 'quietly))
+
+(defmacro gnus-delete-assq (key list)
+ `(let ((listval (eval ,list)))
+ (setq ,list (delq (assq ,key listval) listval))))
+
+(defmacro gnus-delete-assoc (key list)
+ `(let ((listval ,list))
+ (setq ,list (delq (assoc ,key listval) listval))))
+
+(defun gnus-delete-file (file)
+ "Delete FILE if it exists."
+ (when (file-exists-p file)
+ (delete-file file)))
+
+(defun gnus-strip-whitespace (string)
+ "Return STRING stripped of all whitespace."
+ (while (string-match "[\r\n\t ]+" string)
+ (setq string (replace-match "" t t string)))
+ string)
+
+(defun gnus-put-text-property-excluding-newlines (beg end prop val)
+ "The same as `put-text-property', but don't put this prop on any newlines in the region."
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (goto-char beg)
+ (while (re-search-forward "[ \t]*\n" end 'move)
+ (put-text-property beg (match-beginning 0) prop val)
+ (setq beg (point)))
+ (put-text-property beg (point) prop val)))))
+
+;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996
+;;; The primary idea here is to try to protect internal datastructures
+;;; from becoming corrupted when the user hits C-g, or if a hook or
+;;; similar blows up. Often in Gnus multiple tables/lists need to be
+;;; updated at the same time, or information can be lost.
+
+(defvar gnus-atomic-be-safe t
+ "If t, certain operations will be protected from interruption by C-g.")
+
+(defmacro gnus-atomic-progn (&rest forms)
+ "Evaluate FORMS atomically, which means to protect the evaluation
+from being interrupted by the user. An error from the forms themselves
+will return without finishing the operation. Since interrupts from
+the user are disabled, it is recommended that only the most minimal
+operations are performed by FORMS. If you wish to assign many
+complicated values atomically, compute the results into temporary
+variables and then do only the assignment atomically."
+ `(let ((inhibit-quit gnus-atomic-be-safe))
+ ,@forms))
+
+(put 'gnus-atomic-progn 'lisp-indent-function 0)
+
+(defmacro gnus-atomic-progn-assign (protect &rest forms)
+ "Evaluate FORMS, but insure that the variables listed in PROTECT
+are not changed if anything in FORMS signals an error or otherwise
+non-locally exits. The variables listed in PROTECT are updated atomically.
+It is safe to use gnus-atomic-progn-assign with long computations.
+
+Note that if any of the symbols in PROTECT were unbound, they will be
+set to nil on a sucessful assignment. In case of an error or other
+non-local exit, it will still be unbound."
+ (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
+ (concat (symbol-name x)
+ "-tmp"))
+ x))
+ protect))
+ (sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x)))
+ temp-sym-map))
+ (temp-sym-let (mapcar (lambda (x) (list (car x)
+ `(and (boundp ',(cadr x))
+ ,(cadr x))))
+ temp-sym-map))
+ (sym-temp-let sym-temp-map)
+ (temp-sym-assign (apply 'append temp-sym-map))
+ (sym-temp-assign (apply 'append sym-temp-map))
+ (result (make-symbol "result-tmp")))
+ `(let (,@temp-sym-let
+ ,result)
+ (let ,sym-temp-let
+ (setq ,result (progn ,@forms))
+ (setq ,@temp-sym-assign))
+ (let ((inhibit-quit gnus-atomic-be-safe))
+ (setq ,@sym-temp-assign))
+ ,result)))
+
+(put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
+;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
+
+(defmacro gnus-atomic-setq (&rest pairs)
+ "Similar to setq, except that the real symbols are only assigned when
+there are no errors. And when the real symbols are assigned, they are
+done so atomically. If other variables might be changed via side-effect,
+see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq
+with potentially long computations."
+ (let ((tpairs pairs)
+ syms)
+ (while tpairs
+ (push (car tpairs) syms)
+ (setq tpairs (cddr tpairs)))
+ `(gnus-atomic-progn-assign ,syms
+ (setq ,@pairs))))
+
+;(put 'gnus-atomic-setq 'edebug-form-spec '(body))
+
+
+;;; Functions for saving to babyl/mail files.
+
+(defvar rmail-default-rmail-file)
+(defun gnus-output-to-rmail (filename &optional ask)
+ "Append the current article to an Rmail file named FILENAME."
+ (require 'rmail)
+ ;; Most of these codes are borrowed from rmailout.el.
+ (setq filename (expand-file-name filename))
+ (setq rmail-default-rmail-file filename)
+ (let ((artbuf (current-buffer))
+ (tmpbuf (get-buffer-create " *Gnus-output*")))
+ (save-excursion
+ (or (get-file-buffer filename)
+ (file-exists-p filename)
+ (if (or (not ask)
+ (gnus-yes-or-no-p
+ (concat "\"" filename "\" does not exist, create it? ")))
+ (let ((file-buffer (create-file-buffer filename)))
+ (save-excursion
+ (set-buffer file-buffer)
+ (rmail-insert-rmail-file-header)
+ (let ((require-final-newline nil))
+ (gnus-write-buffer filename)))
+ (kill-buffer file-buffer))
+ (error "Output file does not exist")))
+ (set-buffer tmpbuf)
+ (erase-buffer)
+ (insert-buffer-substring artbuf)
+ (gnus-convert-article-to-rmail)
+ ;; Decide whether to append to a file or to an Emacs buffer.
+ (let ((outbuf (get-file-buffer filename)))
+ (if (not outbuf)
+ (append-to-file (point-min) (point-max) filename)
+ ;; File has been visited, in buffer OUTBUF.
+ (set-buffer outbuf)
+ (let ((buffer-read-only nil)
+ (msg (and (boundp 'rmail-current-message)
+ (symbol-value 'rmail-current-message))))
+ ;; If MSG is non-nil, buffer is in RMAIL mode.
+ (when msg
+ (widen)
+ (narrow-to-region (point-max) (point-max)))
+ (insert-buffer-substring tmpbuf)
+ (when msg
+ (goto-char (point-min))
+ (widen)
+ (search-backward "\^_")
+ (narrow-to-region (point) (point-max))
+ (goto-char (1+ (point-min)))
+ (rmail-count-new-messages t)
+ (rmail-show-message msg))))))
+ (kill-buffer tmpbuf)))
+
+(defun gnus-output-to-mail (filename &optional ask)
+ "Append the current article to a mail file named FILENAME."
+ (setq filename (expand-file-name filename))
+ (let ((artbuf (current-buffer))
+ (tmpbuf (get-buffer-create " *Gnus-output*")))
+ (save-excursion
+ ;; Create the file, if it doesn't exist.
+ (when (and (not (get-file-buffer filename))
+ (not (file-exists-p filename)))
+ (if (or (not ask)
+ (gnus-y-or-n-p
+ (concat "\"" filename "\" does not exist, create it? ")))
+ (let ((file-buffer (create-file-buffer filename)))
+ (save-excursion
+ (set-buffer file-buffer)
+ (let ((require-final-newline nil))
+ (gnus-write-buffer filename)))
+ (kill-buffer file-buffer))
+ (error "Output file does not exist")))
+ (set-buffer tmpbuf)
+ (erase-buffer)
+ (insert-buffer-substring artbuf)
+ (goto-char (point-min))
+ (if (looking-at "From ")
+ (forward-line 1)
+ (insert "From nobody " (current-time-string) "\n"))
+ (let (case-fold-search)
+ (while (re-search-forward "^From " nil t)
+ (beginning-of-line)
+ (insert ">")))
+ ;; Decide whether to append to a file or to an Emacs buffer.
+ (let ((outbuf (get-file-buffer filename)))
+ (if (not outbuf)
+ (let ((buffer-read-only nil))
+ (save-excursion
+ (goto-char (point-max))
+ (forward-char -2)
+ (unless (looking-at "\n\n")
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert "\n"))
+ (goto-char (point-max))
+ (append-to-file (point-min) (point-max) filename)))
+ ;; File has been visited, in buffer OUTBUF.
+ (set-buffer outbuf)
+ (let ((buffer-read-only nil))
+ (goto-char (point-max))
+ (unless (eobp)
+ (insert "\n"))
+ (insert "\n")
+ (insert-buffer-substring tmpbuf)))))
+ (kill-buffer tmpbuf)))
+
+(defun gnus-convert-article-to-rmail ()
+ "Convert article in current buffer to Rmail message format."
+ (let ((buffer-read-only nil))
+ ;; Convert article directly into Babyl format.
+ (goto-char (point-min))
+ (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
+ (while (search-forward "\n\^_" nil t) ;single char
+ (replace-match "\n^_" t t)) ;2 chars: "^" and "_"
+ (goto-char (point-max))
+ (insert "\^_")))
+
+(defun gnus-map-function (funs arg)
+ "Applies the result of the first function in FUNS to the second, and so on.
+ARG is passed to the first function."
+ (let ((myfuns funs)
+ (myarg arg))
+ (while myfuns
+ (setq arg (funcall (pop myfuns) arg)))
+ arg))
+
+(provide 'gnus-util)
+
+;;; gnus-util.el ends here
--- /dev/null
+;;; gnus-uu.el --- extract (uu)encoded files in Gnus
+;; Copyright (C) 1985,86,87,93,94,95,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Created: 2 Oct 1993
+;; Keyword: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-art)
+(require 'message)
+(require 'gnus-msg)
+
+(defgroup gnus-extract nil
+ "Extracting encoded files."
+ :prefix "gnus-uu-"
+ :group 'gnus)
+
+(defgroup gnus-extract-view nil
+ "Viewwing extracted files."
+ :group 'gnus-extract)
+
+(defgroup gnus-extract-archive nil
+ "Extracting encoded archives."
+ :group 'gnus-extract)
+
+(defgroup gnus-extract-post nil
+ "Extracting encoded archives."
+ :prefix "gnus-uu-post"
+ :group 'gnus-extract)
+
+;; Default viewing action rules
+
+(defcustom gnus-uu-default-view-rules
+ '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g")
+ ("\\.pas$" "cat %s | sed s/\r//g")
+ ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
+ ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv")
+ ("\\.tga$" "tgatoppm %s | xv -")
+ ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
+ "sox -v .5 %s -t .au -u - > /dev/audio")
+ ("\\.au$" "cat %s > /dev/audio")
+ ("\\.midi?$" "playmidi -f")
+ ("\\.mod$" "str32")
+ ("\\.ps$" "ghostview")
+ ("\\.dvi$" "xdvi")
+ ("\\.html$" "xmosaic")
+ ("\\.mpe?g$" "mpeg_play")
+ ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim")
+ ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
+ "gnus-uu-archive"))
+ "Default actions to be taken when the user asks to view a file.
+To change the behaviour, you can either edit this variable or set
+`gnus-uu-user-view-rules' to something useful.
+
+For example:
+
+To make gnus-uu use 'xli' to display JPEG and GIF files, put the
+following in your .emacs file:
+
+ (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\")))
+
+Both these variables are lists of lists with two string elements. The
+first string is a regular expression. If the file name matches this
+regular expression, the command in the second string is executed with
+the file as an argument.
+
+If the command string contains \"%s\", the file name will be inserted
+at that point in the command string. If there's no \"%s\" in the
+command string, the file name will be appended to the command string
+before executing.
+
+There are several user variables to tailor the behaviour of gnus-uu to
+your needs. First we have `gnus-uu-user-view-rules', which is the
+variable gnus-uu first consults when trying to decide how to view a
+file. If this variable contains no matches, gnus-uu examines the
+default rule variable provided in this package. If gnus-uu finds no
+match here, it uses `gnus-uu-user-view-rules-end' to try to make a
+match."
+ :group 'gnus-extract-view
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defcustom gnus-uu-user-view-rules nil
+ "What actions are to be taken to view a file.
+See the documentation on the `gnus-uu-default-view-rules' variable for
+details."
+ :group 'gnus-extract-view
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defcustom gnus-uu-user-view-rules-end
+ '(("" "file"))
+ "What actions are to be taken if no rule matched the file name.
+See the documentation on the `gnus-uu-default-view-rules' variable for
+details."
+ :group 'gnus-extract-view
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+;; Default unpacking commands
+
+(defcustom gnus-uu-default-archive-rules
+ '(("\\.tar$" "tar xf")
+ ("\\.zip$" "unzip -o")
+ ("\\.ar$" "ar x")
+ ("\\.arj$" "unarj x")
+ ("\\.zoo$" "zoo -e")
+ ("\\.\\(lzh\\|lha\\)$" "lha x")
+ ("\\.Z$" "uncompress")
+ ("\\.gz$" "gunzip")
+ ("\\.arc$" "arc -x"))
+ "See `gnus-uu-user-archive-rules'."
+ :group 'gnus-extract-archive
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defvar gnus-uu-destructive-archivers
+ (list "uncompress" "gunzip"))
+
+(defcustom gnus-uu-user-archive-rules nil
+ "A list that can be set to override the default archive unpacking commands.
+To use, for instance, 'untar' to unpack tar files and 'zip -x' to
+unpack zip files, say the following:
+ (setq gnus-uu-user-archive-rules
+ '((\"\\\\.tar$\" \"untar\")
+ (\"\\\\.zip$\" \"zip -x\")))"
+ :group 'gnus-extract-archive
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defcustom gnus-uu-ignore-files-by-name nil
+ "*A regular expression saying what files should not be viewed based on name.
+If, for instance, you want gnus-uu to ignore all .au and .wav files,
+you could say something like
+
+ (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
+
+Note that this variable can be used in conjunction with the
+`gnus-uu-ignore-files-by-type' variable."
+ :group 'gnus-extract
+ :type '(choice (const :tag "off" nil)
+ (regexp :format "%v")))
+
+(defcustom gnus-uu-ignore-files-by-type nil
+ "*A regular expression saying what files that shouldn't be viewed, based on MIME file type.
+If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
+you could say something like
+
+ (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
+
+Note that this variable can be used in conjunction with the
+`gnus-uu-ignore-files-by-name' variable."
+ :group 'gnus-extract
+ :type '(choice (const :tag "off" nil)
+ (regexp :format "%v")))
+
+;; Pseudo-MIME support
+
+(defconst gnus-uu-ext-to-mime-list
+ '(("\\.gif$" "image/gif")
+ ("\\.jpe?g$" "image/jpeg")
+ ("\\.tiff?$" "image/tiff")
+ ("\\.xwd$" "image/xwd")
+ ("\\.pbm$" "image/pbm")
+ ("\\.pgm$" "image/pgm")
+ ("\\.ppm$" "image/ppm")
+ ("\\.xbm$" "image/xbm")
+ ("\\.pcx$" "image/pcx")
+ ("\\.tga$" "image/tga")
+ ("\\.ps$" "image/postscript")
+ ("\\.fli$" "video/fli")
+ ("\\.wav$" "audio/wav")
+ ("\\.aiff$" "audio/aiff")
+ ("\\.hcom$" "audio/hcom")
+ ("\\.voc$" "audio/voc")
+ ("\\.smp$" "audio/smp")
+ ("\\.mod$" "audio/mod")
+ ("\\.dvi$" "image/dvi")
+ ("\\.mpe?g$" "video/mpeg")
+ ("\\.au$" "audio/basic")
+ ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain")
+ ("\\.\\(c\\|h\\)$" "text/source")
+ ("read.*me" "text/plain")
+ ("\\.html$" "text/html")
+ ("\\.bat$" "text/bat")
+ ("\\.[1-6]$" "text/man")
+ ("\\.flc$" "video/flc")
+ ("\\.rle$" "video/rle")
+ ("\\.pfx$" "video/pfx")
+ ("\\.avi$" "video/avi")
+ ("\\.sme$" "video/sme")
+ ("\\.rpza$" "video/prza")
+ ("\\.dl$" "video/dl")
+ ("\\.qt$" "video/qt")
+ ("\\.rsrc$" "video/rsrc")
+ ("\\..*$" "unknown/unknown")))
+
+;; Various variables users may set
+
+(defcustom gnus-uu-tmp-dir "/tmp/"
+ "*Variable saying where gnus-uu is to do its work.
+Default is \"/tmp/\"."
+ :group 'gnus-extract
+ :type 'directory)
+
+(defcustom gnus-uu-do-not-unpack-archives nil
+ "*Non-nil means that gnus-uu won't peek inside archives looking for files to display.
+Default is nil."
+ :group 'gnus-extract-archive
+ :type 'boolean)
+
+(defcustom gnus-uu-ignore-default-view-rules nil
+ "*Non-nil means that gnus-uu will ignore the default viewing rules.
+Only the user viewing rules will be consulted. Default is nil."
+ :group 'gnus-extract-view
+ :type 'boolean)
+
+(defcustom gnus-uu-grabbed-file-functions nil
+ "Functions run on each file after successful decoding.
+They will be called with the name of the file as the argument.
+Likely functions you can use in this list are `gnus-uu-grab-view'
+and `gnus-uu-grab-move'."
+ :group 'gnus-extract
+ :options '(gnus-uu-grab-view gnus-uu-grab-move)
+ :type 'hook)
+
+(defcustom gnus-uu-ignore-default-archive-rules nil
+ "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
+Only the user unpacking commands will be consulted. Default is nil."
+ :group 'gnus-extract-archive
+ :type 'boolean)
+
+(defcustom gnus-uu-kill-carriage-return t
+ "*Non-nil means that gnus-uu will strip all carriage returns from articles.
+Default is t."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-view-with-metamail nil
+ "*Non-nil means that files will be viewed with metamail.
+The gnus-uu viewing functions will be ignored and gnus-uu will try
+to guess at a content-type based on file name suffixes. Default
+it nil."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-unmark-articles-not-decoded nil
+ "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
+Default is nil."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-correct-stripped-uucode nil
+ "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
+Default is nil."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-save-in-digest nil
+ "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
+If this variable is nil, gnus-uu will just save everything in a
+file without any embellishments. The digesting almost conforms to RFC1153 -
+no easy way to specify any meaningful volume and issue numbers were found,
+so I simply dropped them."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-digest-headers
+ '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
+ "^Summary:" "^References:")
+ "List of regexps to match headers included in digested messages.
+The headers will be included in the sequence they are matched."
+ :group 'gnus-extract
+ :type '(repeat regexp))
+
+(defcustom gnus-uu-save-separate-articles nil
+ "*Non-nil means that gnus-uu will save articles in separate files."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-be-dangerous 'ask
+ "*Specifies what to do if unusual situations arise during decoding.
+If nil, be as conservative as possible. If t, ignore things that
+didn't work, and overwrite existing files. Otherwise, ask each time."
+ :group 'gnus-extract
+ :type '(choice (const :tag "conservative" nil)
+ (const :tag "ask" ask)
+ (const :tag "liberal" t)))
+
+;; Internal variables
+
+(defvar gnus-uu-saved-article-name nil)
+
+(defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
+(defconst gnus-uu-end-string "^end[ \t]*$")
+
+(defconst gnus-uu-body-line "^M")
+(let ((i 61))
+ (while (> (setq i (1- i)) 0)
+ (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
+ (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$")))
+
+;"^M.............................................................?$"
+
+(defconst gnus-uu-shar-begin-string "^#! */bin/sh")
+
+(defvar gnus-uu-shar-file-name nil)
+(defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
+
+(defconst gnus-uu-postscript-begin-string "^%!PS-")
+(defconst gnus-uu-postscript-end-string "^%%EOF$")
+
+(defvar gnus-uu-file-name nil)
+(defconst gnus-uu-uudecode-process nil)
+(defvar gnus-uu-binhex-article-name nil)
+
+(defvar gnus-uu-work-dir nil)
+
+(defconst gnus-uu-output-buffer-name " *Gnus UU Output*")
+
+(defvar gnus-uu-default-dir gnus-article-save-directory)
+(defvar gnus-uu-digest-from-subject nil)
+
+;; Keymaps
+
+(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
+ "p" gnus-summary-mark-as-processable
+ "u" gnus-summary-unmark-as-processable
+ "U" gnus-summary-unmark-all-processable
+ "v" gnus-uu-mark-over
+ "s" gnus-uu-mark-series
+ "r" gnus-uu-mark-region
+ "R" gnus-uu-mark-by-regexp
+ "t" gnus-uu-mark-thread
+ "T" gnus-uu-unmark-thread
+ "a" gnus-uu-mark-all
+ "b" gnus-uu-mark-buffer
+ "S" gnus-uu-mark-sparse
+ "k" gnus-summary-kill-process-mark
+ "y" gnus-summary-yank-process-mark
+ "w" gnus-summary-save-process-mark
+ "i" gnus-uu-invert-processable)
+
+(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
+ ;;"x" gnus-uu-extract-any
+ ;;"m" gnus-uu-extract-mime
+ "u" gnus-uu-decode-uu
+ "U" gnus-uu-decode-uu-and-save
+ "s" gnus-uu-decode-unshar
+ "S" gnus-uu-decode-unshar-and-save
+ "o" gnus-uu-decode-save
+ "O" gnus-uu-decode-save
+ "b" gnus-uu-decode-binhex
+ "B" gnus-uu-decode-binhex
+ "p" gnus-uu-decode-postscript
+ "P" gnus-uu-decode-postscript-and-save)
+
+(gnus-define-keys
+ (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
+ "u" gnus-uu-decode-uu-view
+ "U" gnus-uu-decode-uu-and-save-view
+ "s" gnus-uu-decode-unshar-view
+ "S" gnus-uu-decode-unshar-and-save-view
+ "o" gnus-uu-decode-save-view
+ "O" gnus-uu-decode-save-view
+ "b" gnus-uu-decode-binhex-view
+ "B" gnus-uu-decode-binhex-view
+ "p" gnus-uu-decode-postscript-view
+ "P" gnus-uu-decode-postscript-and-save-view)
+
+
+;; Commands.
+
+(defun gnus-uu-decode-uu (&optional n)
+ "Uudecodes the current article."
+ (interactive "P")
+ (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n))
+
+(defun gnus-uu-decode-uu-and-save (n dir)
+ "Decodes and saves the resulting file."
+ (interactive
+ (list current-prefix-arg
+ (file-name-as-directory
+ (read-file-name "Uudecode and save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t))))
+ (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t))
+
+(defun gnus-uu-decode-unshar (&optional n)
+ "Unshars the current article."
+ (interactive "P")
+ (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t))
+
+(defun gnus-uu-decode-unshar-and-save (n dir)
+ "Unshars and saves the current article."
+ (interactive
+ (list current-prefix-arg
+ (file-name-as-directory
+ (read-file-name "Unshar and save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t))))
+ (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t))
+
+(defun gnus-uu-decode-save (n file)
+ "Saves the current article."
+ (interactive
+ (list current-prefix-arg
+ (read-file-name
+ (if gnus-uu-save-separate-articles
+ "Save articles is dir: "
+ "Save articles in file: ")
+ gnus-uu-default-dir
+ gnus-uu-default-dir)))
+ (setq gnus-uu-saved-article-name file)
+ (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t))
+
+(defun gnus-uu-decode-binhex (n dir)
+ "Unbinhexes the current article."
+ (interactive
+ (list current-prefix-arg
+ (file-name-as-directory
+ (read-file-name "Unbinhex and save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir))))
+ (setq gnus-uu-binhex-article-name
+ (make-temp-name (concat gnus-uu-work-dir "binhex")))
+ (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
+
+(defun gnus-uu-decode-uu-view (&optional n)
+ "Uudecodes and views the current article."
+ (interactive "P")
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
+ (gnus-uu-decode-uu n)))
+
+(defun gnus-uu-decode-uu-and-save-view (n dir)
+ "Decodes, views and saves the resulting file."
+ (interactive
+ (list current-prefix-arg
+ (read-file-name "Uudecode, view and save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t)))
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
+ (gnus-uu-decode-uu-and-save n dir)))
+
+(defun gnus-uu-decode-unshar-view (&optional n)
+ "Unshars and views the current article."
+ (interactive "P")
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
+ (gnus-uu-decode-unshar n)))
+
+(defun gnus-uu-decode-unshar-and-save-view (n dir)
+ "Unshars and saves the current article."
+ (interactive
+ (list current-prefix-arg
+ (read-file-name "Unshar, view and save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t)))
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
+ (gnus-uu-decode-unshar-and-save n dir)))
+
+(defun gnus-uu-decode-save-view (n file)
+ "Saves and views the current article."
+ (interactive
+ (list current-prefix-arg
+ (read-file-name (if gnus-uu-save-separate-articles
+ "Save articles is dir: "
+ "Save articles in file: ")
+ gnus-uu-default-dir gnus-uu-default-dir)))
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
+ (gnus-uu-decode-save n file)))
+
+(defun gnus-uu-decode-binhex-view (n file)
+ "Unbinhexes and views the current article."
+ (interactive
+ (list current-prefix-arg
+ (read-file-name "Unbinhex, view and save in dir: "
+ gnus-uu-default-dir gnus-uu-default-dir)))
+ (setq gnus-uu-binhex-article-name
+ (make-temp-name (concat gnus-uu-work-dir "binhex")))
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
+ (gnus-uu-decode-binhex n file)))
+
+
+;; Digest and forward articles
+
+(defun gnus-uu-digest-mail-forward (&optional n post)
+ "Digests and forwards all articles in this series."
+ (interactive "P")
+ (let ((gnus-uu-save-in-digest t)
+ (file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward")))
+ buf subject from newsgroups)
+ (gnus-setup-message 'forward
+ (setq gnus-uu-digest-from-subject nil)
+ (gnus-uu-decode-save n file)
+ (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*")))
+ (gnus-add-current-to-buffer-list)
+ (erase-buffer)
+ (insert-file file)
+ (let ((fs gnus-uu-digest-from-subject))
+ (when fs
+ (setq from (caar fs)
+ subject (gnus-simplify-subject-fuzzy (cdar fs))
+ fs (cdr fs))
+ (while (and fs (or from subject))
+ (when from
+ (unless (string= from (caar fs))
+ (setq from nil)))
+ (when subject
+ (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
+ subject)
+ (setq subject nil)))
+ (setq fs (cdr fs))))
+ (unless subject
+ (setq subject "Digested Articles"))
+ (unless from
+ (setq from
+ (if (gnus-news-group-p gnus-newsgroup-name)
+ gnus-newsgroup-name
+ "Various"))))
+ (goto-char (point-min))
+ (when (re-search-forward "^Subject: ")
+ (delete-region (point) (gnus-point-at-eol))
+ (insert subject))
+ (goto-char (point-min))
+ (when (re-search-forward "^From: ")
+ (delete-region (point) (gnus-point-at-eol))
+ (insert from))
+ (message-forward post))
+ (delete-file file)
+ (kill-buffer buf)
+ (setq gnus-uu-digest-from-subject nil)))
+
+(defun gnus-uu-digest-post-forward (&optional n)
+ "Digest and forward to a newsgroup."
+ (interactive "P")
+ (gnus-uu-digest-mail-forward n t))
+
+;; Process marking.
+
+(defun gnus-uu-mark-by-regexp (regexp &optional unmark)
+ "Ask for a regular expression and set the process mark on all articles that match."
+ (interactive (list (read-from-minibuffer "Mark (regexp): ")))
+ (gnus-set-global-variables)
+ (let ((articles (gnus-uu-find-articles-matching regexp)))
+ (while articles
+ (if unmark
+ (gnus-summary-remove-process-mark (pop articles))
+ (gnus-summary-set-process-mark (pop articles))))
+ (message ""))
+ (gnus-summary-position-point))
+
+(defun gnus-uu-unmark-by-regexp (regexp &optional unmark)
+ "Ask for a regular expression and remove the process mark on all articles that match."
+ (interactive (list (read-from-minibuffer "Mark (regexp): ")))
+ (gnus-uu-mark-by-regexp regexp t))
+
+(defun gnus-uu-mark-series ()
+ "Mark the current series with the process mark."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((articles (gnus-uu-find-articles-matching)))
+ (while articles
+ (gnus-summary-set-process-mark (car articles))
+ (setq articles (cdr articles)))
+ (message ""))
+ (gnus-summary-position-point))
+
+(defun gnus-uu-mark-region (beg end &optional unmark)
+ "Set the process mark on all articles between point and mark."
+ (interactive "r")
+ (gnus-set-global-variables)
+ (save-excursion
+ (goto-char beg)
+ (while (< (point) end)
+ (if unmark
+ (gnus-summary-remove-process-mark (gnus-summary-article-number))
+ (gnus-summary-set-process-mark (gnus-summary-article-number)))
+ (forward-line 1)))
+ (gnus-summary-position-point))
+
+(defun gnus-uu-unmark-region (beg end)
+ "Remove the process mark from all articles between point and mark."
+ (interactive "r")
+ (gnus-uu-mark-region beg end t))
+
+(defun gnus-uu-mark-buffer ()
+ "Set the process mark on all articles in the buffer."
+ (interactive)
+ (gnus-uu-mark-region (point-min) (point-max)))
+
+(defun gnus-uu-unmark-buffer ()
+ "Remove the process mark on all articles in the buffer."
+ (interactive)
+ (gnus-uu-mark-region (point-min) (point-max) t))
+
+(defun gnus-uu-mark-thread ()
+ "Marks all articles downwards in this thread."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((level (gnus-summary-thread-level)))
+ (while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
+ (zerop (gnus-summary-next-subject 1))
+ (> (gnus-summary-thread-level) level))))
+ (gnus-summary-position-point))
+
+(defun gnus-uu-unmark-thread ()
+ "Unmarks all articles downwards in this thread."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((level (gnus-summary-thread-level)))
+ (while (and (gnus-summary-remove-process-mark
+ (gnus-summary-article-number))
+ (zerop (gnus-summary-next-subject 1))
+ (> (gnus-summary-thread-level) level))))
+ (gnus-summary-position-point))
+
+(defun gnus-uu-invert-processable ()
+ "Invert the list of process-marked articles."
+ (let ((data gnus-newsgroup-data)
+ d number)
+ (save-excursion
+ (while data
+ (if (memq (setq number (gnus-data-number (pop data)))
+ gnus-newsgroup-processable)
+ (gnus-summary-remove-process-mark number)
+ (gnus-summary-set-process-mark number)))))
+ (gnus-summary-position-point))
+
+(defun gnus-uu-mark-over (&optional score)
+ "Mark all articles with a score over SCORE (the prefix.)"
+ (interactive "P")
+ (let ((score (gnus-score-default score))
+ (data gnus-newsgroup-data))
+ (save-excursion
+ (while data
+ (when (> (or (cdr (assq (gnus-data-number (car data))
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0)
+ score)
+ (gnus-summary-set-process-mark (caar data)))
+ (setq data (cdr data))))
+ (gnus-summary-position-point)))
+
+(defun gnus-uu-mark-sparse ()
+ "Mark all series that have some articles marked."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((marked (nreverse gnus-newsgroup-processable))
+ subject articles total headers)
+ (unless marked
+ (error "No articles marked with the process mark"))
+ (setq gnus-newsgroup-processable nil)
+ (save-excursion
+ (while marked
+ (and (vectorp (setq headers
+ (gnus-summary-article-header (car marked))))
+ (setq subject (mail-header-subject headers)
+ articles (gnus-uu-find-articles-matching
+ (gnus-uu-reginize-string subject))
+ total (nconc total articles)))
+ (while articles
+ (gnus-summary-set-process-mark (car articles))
+ (setcdr marked (delq (car articles) (cdr marked)))
+ (setq articles (cdr articles)))
+ (setq marked (cdr marked)))
+ (setq gnus-newsgroup-processable (nreverse total)))
+ (gnus-summary-position-point)))
+
+(defun gnus-uu-mark-all ()
+ "Mark all articles in \"series\" order."
+ (interactive)
+ (gnus-set-global-variables)
+ (setq gnus-newsgroup-processable nil)
+ (save-excursion
+ (let ((data gnus-newsgroup-data)
+ number)
+ (while data
+ (when (and (not (memq (setq number (gnus-data-number (car data)))
+ gnus-newsgroup-processable))
+ (vectorp (gnus-data-header (car data))))
+ (gnus-summary-goto-subject number)
+ (gnus-uu-mark-series))
+ (setq data (cdr data)))))
+ (gnus-summary-position-point))
+
+;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
+
+(defun gnus-uu-decode-postscript (&optional n)
+ "Gets postscript of the current article."
+ (interactive "P")
+ (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n))
+
+(defun gnus-uu-decode-postscript-view (&optional n)
+ "Gets and views the current article."
+ (interactive "P")
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
+ (gnus-uu-decode-postscript n)))
+
+(defun gnus-uu-decode-postscript-and-save (n dir)
+ "Extracts postscript and saves the current article."
+ (interactive
+ (list current-prefix-arg
+ (file-name-as-directory
+ (read-file-name "Save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t))))
+ (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article
+ n dir nil nil t))
+
+(defun gnus-uu-decode-postscript-and-save-view (n dir)
+ "Decodes, views and saves the resulting file."
+ (interactive
+ (list current-prefix-arg
+ (read-file-name "Where do you want to save the file(s)? "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t)))
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
+ (gnus-uu-decode-postscript-and-save n dir)))
+
+
+;; Internal functions.
+
+(defun gnus-uu-decode-with-method (method n &optional save not-insert
+ scan cdir)
+ (gnus-uu-initialize scan)
+ (when save
+ (setq gnus-uu-default-dir save))
+ ;; Create the directory we save to.
+ (when (and scan cdir save
+ (not (file-exists-p save)))
+ (make-directory save t))
+ (let ((articles (gnus-uu-get-list-of-articles n))
+ files)
+ (setq files (gnus-uu-grab-articles articles method t))
+ (let ((gnus-current-article (car articles)))
+ (when scan
+ (setq files (gnus-uu-scan-directory gnus-uu-work-dir))))
+ (when save
+ (gnus-uu-save-files files save))
+ (when (eq gnus-uu-do-not-unpack-archives nil)
+ (setq files (gnus-uu-unpack-files files)))
+ (setq files (nreverse (gnus-uu-get-actions files)))
+ (or not-insert (not gnus-insert-pseudo-articles)
+ (gnus-summary-insert-pseudos files save))))
+
+(defun gnus-uu-scan-directory (dir &optional rec)
+ "Return a list of all files under DIR."
+ (let ((files (directory-files dir t))
+ out file)
+ (while (setq file (pop files))
+ (unless (member (file-name-nondirectory file) '("." ".."))
+ (push (list (cons 'name file)
+ (cons 'article gnus-current-article))
+ out)
+ (when (file-directory-p file)
+ (setq out (nconc (gnus-uu-scan-directory file t) out)))))
+ (if rec
+ out
+ (nreverse out))))
+
+(defun gnus-uu-save-files (files dir)
+ "Save FILES in DIR."
+ (let ((len (length files))
+ (reg (concat "^" (regexp-quote gnus-uu-work-dir)))
+ to-file file fromdir)
+ (while (setq file (cdr (assq 'name (pop files))))
+ (when (file-exists-p file)
+ (string-match reg file)
+ (setq fromdir (substring file (match-end 0)))
+ (if (file-directory-p file)
+ (gnus-make-directory (concat dir fromdir))
+ (setq to-file (concat dir fromdir))
+ (when (or (not (file-exists-p to-file))
+ (eq gnus-uu-be-dangerous t)
+ (and gnus-uu-be-dangerous
+ (gnus-y-or-n-p (format "%s exists; overwrite? "
+ to-file))))
+ (copy-file file to-file t t)))))
+ (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s"))))
+
+;; Functions for saving and possibly digesting articles without
+;; any decoding.
+
+;; Function called by gnus-uu-grab-articles to treat each article.
+(defun gnus-uu-save-article (buffer in-state)
+ (cond
+ (gnus-uu-save-separate-articles
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-write-buffer
+ (concat gnus-uu-saved-article-name gnus-current-article))
+ (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
+ ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
+ 'begin 'end))
+ ((eq in-state 'last) (list 'end))
+ (t (list 'middle)))))
+ ((not gnus-uu-save-in-digest)
+ (save-excursion
+ (set-buffer buffer)
+ (write-region (point-min) (point-max) gnus-uu-saved-article-name t)
+ (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
+ ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
+ 'begin 'end))
+ ((eq in-state 'last) (list 'end))
+ (t (list 'middle)))))
+ (t
+ (let ((header (gnus-summary-article-header)))
+ (push (cons (mail-header-from header)
+ (mail-header-subject header))
+ gnus-uu-digest-from-subject))
+ (let ((name (file-name-nondirectory gnus-uu-saved-article-name))
+ (delim (concat "^" (make-string 30 ?-) "$"))
+ beg subj headers headline sorthead body end-string state)
+ (if (or (eq in-state 'first)
+ (eq in-state 'first-and-last))
+ (progn
+ (setq state (list 'begin))
+ (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*"))
+ (erase-buffer))
+ (save-excursion
+ (set-buffer (get-buffer-create "*gnus-uu-pre*"))
+ (erase-buffer)
+ (insert (format
+ "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n"
+ (current-time-string) name name))))
+ (when (not (eq in-state 'end))
+ (setq state (list 'middle))))
+ (save-excursion
+ (set-buffer (get-buffer "*gnus-uu-body*"))
+ (goto-char (setq beg (point-max)))
+ (save-excursion
+ (save-restriction
+ (set-buffer buffer)
+ (let (buffer-read-only)
+ (gnus-set-text-properties (point-min) (point-max) nil)
+ ;; These two are necessary for XEmacs 19.12 fascism.
+ (put-text-property (point-min) (point-max) 'invisible nil)
+ (put-text-property (point-min) (point-max) 'intangible nil))
+ (goto-char (point-min))
+ (re-search-forward "\n\n")
+ ;; Quote all 30-dash lines.
+ (save-excursion
+ (while (re-search-forward delim nil t)
+ (beginning-of-line)
+ (delete-char 1)
+ (insert " ")))
+ (setq body (buffer-substring (1- (point)) (point-max)))
+ (narrow-to-region (point-min) (point))
+ (if (not (setq headers gnus-uu-digest-headers))
+ (setq sorthead (buffer-substring (point-min) (point-max)))
+ (while headers
+ (setq headline (car headers))
+ (setq headers (cdr headers))
+ (goto-char (point-min))
+ (while (re-search-forward headline nil t)
+ (setq sorthead
+ (concat sorthead
+ (buffer-substring
+ (match-beginning 0)
+ (or (and (re-search-forward "^[^ \t]" nil t)
+ (1- (point)))
+ (progn (forward-line 1) (point)))))))))
+ (widen)))
+ (insert sorthead) (goto-char (point-max))
+ (insert body) (goto-char (point-max))
+ (insert (concat "\n" (make-string 30 ?-) "\n\n"))
+ (goto-char beg)
+ (when (re-search-forward "^Subject: \\(.*\\)$" nil t)
+ (setq subj (buffer-substring (match-beginning 1) (match-end 1)))
+ (save-excursion
+ (set-buffer (get-buffer "*gnus-uu-pre*"))
+ (insert (format " %s\n" subj)))))
+ (when (or (eq in-state 'last)
+ (eq in-state 'first-and-last))
+ (save-excursion
+ (set-buffer (get-buffer "*gnus-uu-pre*"))
+ (insert (format "\n\n%s\n\n" (make-string 70 ?-)))
+ (gnus-write-buffer gnus-uu-saved-article-name))
+ (save-excursion
+ (set-buffer (get-buffer "*gnus-uu-body*"))
+ (goto-char (point-max))
+ (insert
+ (concat (setq end-string (format "End of %s Digest" name))
+ "\n"))
+ (insert (concat (make-string (length end-string) ?*) "\n"))
+ (write-region
+ (point-min) (point-max) gnus-uu-saved-article-name t))
+ (kill-buffer (get-buffer "*gnus-uu-pre*"))
+ (kill-buffer (get-buffer "*gnus-uu-body*"))
+ (push 'end state))
+ (if (memq 'begin state)
+ (cons gnus-uu-saved-article-name state)
+ state)))))
+
+;; Binhex treatment - not very advanced.
+
+(defconst gnus-uu-binhex-body-line
+ "^[^:]...............................................................$")
+(defconst gnus-uu-binhex-begin-line
+ "^:...............................................................$")
+(defconst gnus-uu-binhex-end-line
+ ":$")
+
+(defun gnus-uu-binhex-article (buffer in-state)
+ (let (state start-char)
+ (save-excursion
+ (set-buffer buffer)
+ (widen)
+ (goto-char (point-min))
+ (when (not (re-search-forward gnus-uu-binhex-begin-line nil t))
+ (when (not (re-search-forward gnus-uu-binhex-body-line nil t))
+ (setq state (list 'wrong-type))))
+
+ (if (memq 'wrong-type state)
+ ()
+ (beginning-of-line)
+ (setq start-char (point))
+ (if (looking-at gnus-uu-binhex-begin-line)
+ (progn
+ (setq state (list 'begin))
+ (write-region 1 1 gnus-uu-binhex-article-name))
+ (setq state (list 'middle)))
+ (goto-char (point-max))
+ (re-search-backward (concat gnus-uu-binhex-body-line "\\|"
+ gnus-uu-binhex-end-line)
+ nil t)
+ (when (looking-at gnus-uu-binhex-end-line)
+ (setq state (if (memq 'begin state)
+ (cons 'end state)
+ (list 'end))))
+ (beginning-of-line)
+ (forward-line 1)
+ (when (file-exists-p gnus-uu-binhex-article-name)
+ (append-to-file start-char (point) gnus-uu-binhex-article-name))))
+ (if (memq 'begin state)
+ (cons gnus-uu-binhex-article-name state)
+ state)))
+
+;; PostScript
+
+(defun gnus-uu-decode-postscript-article (process-buffer in-state)
+ (let ((state (list 'ok))
+ start-char end-char file-name)
+ (save-excursion
+ (set-buffer process-buffer)
+ (goto-char (point-min))
+ (if (not (re-search-forward gnus-uu-postscript-begin-string nil t))
+ (setq state (list 'wrong-type))
+ (beginning-of-line)
+ (setq start-char (point))
+ (if (not (re-search-forward gnus-uu-postscript-end-string nil t))
+ (setq state (list 'wrong-type))
+ (setq end-char (point))
+ (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+ (insert-buffer-substring process-buffer start-char end-char)
+ (setq file-name (concat gnus-uu-work-dir
+ (cdr gnus-article-current) ".ps"))
+ (write-region (point-min) (point-max) file-name)
+ (setq state (list file-name 'begin 'end)))))
+ state))
+
+
+;; Find actions.
+
+(defun gnus-uu-get-actions (files)
+ (let ((ofiles files)
+ action name)
+ (while files
+ (setq name (cdr (assq 'name (car files))))
+ (and
+ (setq action (gnus-uu-get-action name))
+ (setcar files (nconc (list (if (string= action "gnus-uu-archive")
+ (cons 'action "file")
+ (cons 'action action))
+ (cons 'execute (gnus-uu-command
+ action name)))
+ (car files))))
+ (setq files (cdr files)))
+ ofiles))
+
+(defun gnus-uu-get-action (file-name)
+ (let (action)
+ (setq action
+ (gnus-uu-choose-action
+ file-name
+ (append
+ gnus-uu-user-view-rules
+ (if gnus-uu-ignore-default-view-rules
+ nil
+ gnus-uu-default-view-rules)
+ gnus-uu-user-view-rules-end)))
+ (when (and (not (string= (or action "") "gnus-uu-archive"))
+ gnus-uu-view-with-metamail)
+ (when (setq action
+ (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list))
+ (setq action (format "metamail -d -b -c \"%s\"" action))))
+ action))
+
+
+;; Functions for treating subjects and collecting series.
+
+(defun gnus-uu-reginize-string (string)
+ ;; Takes a string and puts a \ in front of every special character;
+ ;; ignores any leading "version numbers" thingies that they use in
+ ;; the comp.binaries groups, and either replaces anything that looks
+ ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something
+ ;; like that, replaces the last two numbers with "[0-9]+". This, in
+ ;; my experience, should get most postings of a series.
+ (let ((count 2)
+ (vernum "v[0-9]+[a-z][0-9]+:")
+ beg)
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert (regexp-quote string))
+ (setq beg 1)
+
+ (setq case-fold-search nil)
+ (goto-char (point-min))
+ (when (looking-at vernum)
+ (replace-match vernum t t)
+ (setq beg (length vernum)))
+
+ (goto-char beg)
+ (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t)
+ (replace-match " [0-9]+/[0-9]+")
+
+ (goto-char beg)
+ (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t)
+ (replace-match "[0-9]+ of [0-9]+")
+
+ (end-of-line)
+ (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+"
+ nil t)
+ (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil))))
+
+ (goto-char beg)
+ (while (re-search-forward "[ \t]+" nil t)
+ (replace-match "[ \t]*" t t))
+
+ (buffer-substring 1 (point-max)))))
+
+(defun gnus-uu-get-list-of-articles (n)
+ ;; If N is non-nil, the article numbers of the N next articles
+ ;; will be returned.
+ ;; If any articles have been marked as processable, they will be
+ ;; returned.
+ ;; Failing that, articles that have subjects that are part of the
+ ;; same "series" as the current will be returned.
+ (let (articles)
+ (cond
+ (n
+ (setq n (prefix-numeric-value n))
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (save-excursion
+ (while (and (> n 0)
+ (push (gnus-summary-article-number)
+ articles)
+ (gnus-summary-search-forward nil nil backward))
+ (setq n (1- n))))
+ (nreverse articles)))
+ (gnus-newsgroup-processable
+ (reverse gnus-newsgroup-processable))
+ (t
+ (gnus-uu-find-articles-matching)))))
+
+(defun gnus-uu-string< (l1 l2)
+ (string< (car l1) (car l2)))
+
+(defun gnus-uu-find-articles-matching
+ (&optional subject only-unread do-not-translate)
+ ;; Finds all articles that matches the regexp SUBJECT. If it is
+ ;; nil, the current article name will be used. If ONLY-UNREAD is
+ ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is
+ ;; non-nil, article names are not equalized before sorting.
+ (let ((subject (or subject
+ (gnus-uu-reginize-string (gnus-summary-article-subject))))
+ list-of-subjects)
+ (save-excursion
+ (if (not subject)
+ ()
+ ;; Collect all subjects matching subject.
+ (let ((case-fold-search t)
+ (data gnus-newsgroup-data)
+ subj mark d)
+ (while data
+ (setq d (pop data))
+ (and (not (gnus-data-pseudo-p d))
+ (or (not only-unread)
+ (= (setq mark (gnus-data-mark d))
+ gnus-unread-mark)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark))
+ (setq subj (mail-header-subject (gnus-data-header d)))
+ (string-match subject subj)
+ (push (cons subj (gnus-data-number d))
+ list-of-subjects))))
+
+ ;; Expand numbers, sort, and return the list of article
+ ;; numbers.
+ (mapcar (lambda (sub) (cdr sub))
+ (sort (gnus-uu-expand-numbers
+ list-of-subjects
+ (not do-not-translate))
+ 'gnus-uu-string<))))))
+
+(defun gnus-uu-expand-numbers (string-list &optional translate)
+ ;; Takes a list of strings and "expands" all numbers in all the
+ ;; strings. That is, this function makes all numbers equal length by
+ ;; prepending lots of zeroes before each number. This is to ease later
+ ;; sorting to find out what sequence the articles are supposed to be
+ ;; decoded in. Returns the list of expanded strings.
+ (let ((out-list string-list)
+ string)
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+ (buffer-disable-undo (current-buffer))
+ (while string-list
+ (erase-buffer)
+ (insert (caar string-list))
+ ;; Translate multiple spaces to one space.
+ (goto-char (point-min))
+ (while (re-search-forward "[ \t]+" nil t)
+ (replace-match " "))
+ ;; Translate all characters to "a".
+ (goto-char (point-min))
+ (when translate
+ (while (re-search-forward "[A-Za-z]" nil t)
+ (replace-match "a" t t)))
+ ;; Expand numbers.
+ (goto-char (point-min))
+ (while (re-search-forward "[0-9]+" nil t)
+ (replace-match
+ (format "%06d"
+ (string-to-int (buffer-substring
+ (match-beginning 0) (match-end 0))))))
+ (setq string (buffer-substring 1 (point-max)))
+ (setcar (car string-list) string)
+ (setq string-list (cdr string-list))))
+ out-list))
+
+
+;; `gnus-uu-grab-articles' is the general multi-article treatment
+;; function. It takes a list of articles to be grabbed and a function
+;; to apply to each article.
+;;
+;; The function to be called should take two parameters. The first
+;; parameter is the article buffer. The function should leave the
+;; result, if any, in this buffer. Most treatment functions will just
+;; generate files...
+;;
+;; The second parameter is the state of the list of articles, and can
+;; have four values: `first', `middle', `last' and `first-and-last'.
+;;
+;; The function should return a list. The list may contain the
+;; following symbols:
+;; `error' if an error occurred
+;; `begin' if the beginning of an encoded file has been received
+;; If the list returned contains a `begin', the first element of
+;; the list *must* be a string with the file name of the decoded
+;; file.
+;; `end' if the end of an encoded file has been received
+;; `middle' if the article was a body part of an encoded file
+;; `wrong-type' if the article was not a part of an encoded file
+;; `ok', which can be used everything is ok
+
+(defvar gnus-uu-has-been-grabbed nil)
+
+(defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article)
+ (let (art)
+ (if (not (and gnus-uu-has-been-grabbed
+ gnus-uu-unmark-articles-not-decoded))
+ ()
+ (when dont-unmark-last-article
+ (setq art (car gnus-uu-has-been-grabbed))
+ (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
+ (while gnus-uu-has-been-grabbed
+ (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t)
+ (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
+ (when dont-unmark-last-article
+ (setq gnus-uu-has-been-grabbed (list art))))))
+
+;; This function takes a list of articles and a function to apply to
+;; each article grabbed.
+;;
+;; This function returns a list of files decoded if the grabbing and
+;; the process-function has been successful and nil otherwise.
+(defun gnus-uu-grab-articles (articles process-function
+ &optional sloppy limit no-errors)
+ (let ((state 'first)
+ has-been-begin article result-file result-files process-state
+ gnus-summary-display-article-function
+ gnus-article-display-hook gnus-article-prepare-hook
+ article-series files)
+
+ (while (and articles
+ (not (memq 'error process-state))
+ (or sloppy
+ (not (memq 'end process-state))))
+
+ (setq article (pop articles))
+ (push article article-series)
+
+ (unless articles
+ (if (eq state 'first)
+ (setq state 'first-and-last)
+ (setq state 'last)))
+
+ (let ((part (gnus-uu-part-number article)))
+ (gnus-message 6 "Getting article %d%s..."
+ article (if (string= part "") "" (concat ", " part))))
+ (gnus-summary-display-article article)
+
+ ;; Push the article to the processing function.
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (let ((buffer-read-only nil))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (setq process-state
+ (funcall process-function
+ gnus-original-article-buffer state)))))
+
+ (gnus-summary-remove-process-mark article)
+
+ ;; If this is the beginning of a decoded file, we push it
+ ;; on to a list.
+ (when (or (memq 'begin process-state)
+ (and (or (eq state 'first)
+ (eq state 'first-and-last))
+ (memq 'ok process-state)))
+ (when has-been-begin
+ ;; If there is a `result-file' here, that means that the
+ ;; file was unsuccessfully decoded, so we delete it.
+ (when (and result-file
+ (file-exists-p result-file)
+ (not gnus-uu-be-dangerous)
+ (or (eq gnus-uu-be-dangerous t)
+ (gnus-y-or-n-p
+ (format "Delete unsuccessfully decoded file %s"
+ result-file))))
+ (delete-file result-file)))
+ (when (memq 'begin process-state)
+ (setq result-file (car process-state)))
+ (setq has-been-begin t))
+
+ ;; Check whether we have decoded one complete file.
+ (when (memq 'end process-state)
+ (setq article-series nil)
+ (setq has-been-begin nil)
+ (if (stringp result-file)
+ (setq files (list result-file))
+ (setq files result-file))
+ (setq result-file (car files))
+ (while files
+ (push (list (cons 'name (pop files))
+ (cons 'article article))
+ result-files))
+ ;; Allow user-defined functions to be run on this file.
+ (when gnus-uu-grabbed-file-functions
+ (let ((funcs gnus-uu-grabbed-file-functions))
+ (unless (listp funcs)
+ (setq funcs (list funcs)))
+ (while funcs
+ (funcall (pop funcs) result-file))))
+ (setq result-file nil)
+ ;; Check whether we have decoded enough articles.
+ (and limit (= (length result-files) limit)
+ (setq articles nil)))
+
+ ;; If this is the last article to be decoded, and
+ ;; we still haven't reached the end, then we delete
+ ;; the partially decoded file.
+ (and (or (eq state 'last) (eq state 'first-and-last))
+ (not (memq 'end process-state))
+ result-file
+ (file-exists-p result-file)
+ (not gnus-uu-be-dangerous)
+ (or (eq gnus-uu-be-dangerous t)
+ (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file)))
+ (delete-file result-file))
+
+ ;; If this was a file of the wrong sort, then
+ (when (and (or (memq 'wrong-type process-state)
+ (memq 'error process-state))
+ gnus-uu-unmark-articles-not-decoded)
+ (gnus-summary-tick-article article t))
+
+ ;; Set the new series state.
+ (if (and (not has-been-begin)
+ (not sloppy)
+ (or (memq 'end process-state)
+ (memq 'middle process-state)))
+ (progn
+ (setq process-state (list 'error))
+ (gnus-message 2 "No begin part at the beginning")
+ (sleep-for 2))
+ (setq state 'middle)))
+
+ ;; When there are no result-files, then something must be wrong.
+ (if result-files
+ (message "")
+ (cond
+ ((not has-been-begin)
+ (gnus-message 2 "Wrong type file"))
+ ((memq 'error process-state)
+ (gnus-message 2 "An error occurred during decoding"))
+ ((not (or (memq 'ok process-state)
+ (memq 'end process-state)))
+ (gnus-message 2 "End of articles reached before end of file")))
+ ;; Make unsuccessfully decoded articles unread.
+ (when gnus-uu-unmark-articles-not-decoded
+ (while article-series
+ (gnus-summary-tick-article (pop article-series) t))))
+
+ result-files))
+
+(defun gnus-uu-grab-view (file)
+ "View FILE using the gnus-uu methods."
+ (let ((action (gnus-uu-get-action file)))
+ (gnus-execute-command
+ (if (string-match "%" action)
+ (format action file)
+ (concat action " " file))
+ (eq gnus-view-pseudos 'not-confirm))))
+
+(defun gnus-uu-grab-move (file)
+ "Move FILE to somewhere."
+ (when gnus-uu-default-dir
+ (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir)
+ (file-name-nondirectory file))))
+ (rename-file file to-file)
+ (unless (file-exists-p file)
+ (make-symbolic-link to-file file)))))
+
+(defun gnus-uu-part-number (article)
+ (let* ((header (gnus-summary-article-header article))
+ (subject (and header (mail-header-subject header))))
+ (if (and subject
+ (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject))
+ (match-string 0 subject)
+ "")))
+
+(defun gnus-uu-uudecode-sentinel (process event)
+ (delete-process (get-process process)))
+
+(defun gnus-uu-uustrip-article (process-buffer in-state)
+ ;; Uudecodes a file asynchronously.
+ (save-excursion
+ (set-buffer process-buffer)
+ (let ((state (list 'wrong-type))
+ process-connection-type case-fold-search buffer-read-only
+ files start-char)
+ (goto-char (point-min))
+
+ ;; Deal with ^M at the end of the lines.
+ (when gnus-uu-kill-carriage-return
+ (save-excursion
+ (while (search-forward "\r" nil t)
+ (delete-backward-char 1))))
+
+ (while (or (re-search-forward gnus-uu-begin-string nil t)
+ (re-search-forward gnus-uu-body-line nil t))
+ (setq state (list 'ok))
+ ;; Ok, we are at the first uucoded line.
+ (beginning-of-line)
+ (setq start-char (point))
+
+ (if (not (looking-at gnus-uu-begin-string))
+ (setq state (list 'middle))
+ ;; This is the beginning of a uuencoded article.
+ ;; We replace certain characters that could make things messy.
+ (setq gnus-uu-file-name
+ (let ((nnheader-file-name-translation-alist
+ '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
+ (nnheader-translate-file-chars (match-string 1))))
+ (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
+
+ ;; Remove any non gnus-uu-body-line right after start.
+ (forward-line 1)
+ (while (and (not (eobp))
+ (not (looking-at gnus-uu-body-line)))
+ (gnus-delete-line))
+
+ ;; If a process is running, we kill it.
+ (when (and gnus-uu-uudecode-process
+ (memq (process-status gnus-uu-uudecode-process)
+ '(run stop)))
+ (delete-process gnus-uu-uudecode-process)
+ (gnus-uu-unmark-list-of-grabbed t))
+
+ ;; Start a new uudecoding process.
+ (let ((cdir default-directory))
+ (unwind-protect
+ (progn
+ (cd gnus-uu-work-dir)
+ (setq gnus-uu-uudecode-process
+ (start-process
+ "*uudecode*"
+ (get-buffer-create gnus-uu-output-buffer-name)
+ shell-file-name shell-command-switch
+ (format "cd %s %s uudecode" gnus-uu-work-dir
+ gnus-shell-command-separator))))
+ (cd cdir)))
+ (set-process-sentinel
+ gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
+ (setq state (list 'begin))
+ (push (concat gnus-uu-work-dir gnus-uu-file-name) files))
+
+ ;; We look for the end of the thing to be decoded.
+ (if (re-search-forward gnus-uu-end-string nil t)
+ (push 'end state)
+ (goto-char (point-max))
+ (re-search-backward gnus-uu-body-line nil t))
+
+ (forward-line 1)
+
+ (when gnus-uu-uudecode-process
+ (when (memq (process-status gnus-uu-uudecode-process) '(run stop))
+ ;; Try to correct mishandled uucode.
+ (when gnus-uu-correct-stripped-uucode
+ (gnus-uu-check-correct-stripped-uucode start-char (point)))
+
+ ;; Send the text to the process.
+ (condition-case nil
+ (process-send-region
+ gnus-uu-uudecode-process start-char (point))
+ (error
+ (progn
+ (delete-process gnus-uu-uudecode-process)
+ (gnus-message 2 "gnus-uu: Couldn't uudecode")
+ (setq state (list 'wrong-type)))))
+
+ (if (memq 'end state)
+ (progn
+ ;; Send an EOF, just in case.
+ (ignore-errors
+ (process-send-eof gnus-uu-uudecode-process))
+ (while (memq (process-status gnus-uu-uudecode-process)
+ '(open run))
+ (accept-process-output gnus-uu-uudecode-process 1)))
+ (when (or (not gnus-uu-uudecode-process)
+ (not (memq (process-status gnus-uu-uudecode-process)
+ '(run stop))))
+ (setq state (list 'wrong-type)))))))
+
+ (if (memq 'begin state)
+ (cons (if (= (length files) 1) (car files) files) state)
+ state))))
+
+;; This function is used by `gnus-uu-grab-articles' to treat
+;; a shared article.
+(defun gnus-uu-unshar-article (process-buffer in-state)
+ (let ((state (list 'ok))
+ start-char)
+ (save-excursion
+ (set-buffer process-buffer)
+ (goto-char (point-min))
+ (if (not (re-search-forward gnus-uu-shar-begin-string nil t))
+ (setq state (list 'wrong-type))
+ (beginning-of-line)
+ (setq start-char (point))
+ (call-process-region
+ start-char (point-max) shell-file-name nil
+ (get-buffer-create gnus-uu-output-buffer-name) nil
+ shell-command-switch
+ (concat "cd " gnus-uu-work-dir " "
+ gnus-shell-command-separator " sh"))))
+ state))
+
+;; Returns the name of what the shar file is going to unpack.
+(defun gnus-uu-find-name-in-shar ()
+ (let ((oldpoint (point))
+ res)
+ (goto-char (point-min))
+ (when (re-search-forward gnus-uu-shar-name-marker nil t)
+ (setq res (buffer-substring (match-beginning 1) (match-end 1))))
+ (goto-char oldpoint)
+ res))
+
+;; `gnus-uu-choose-action' chooses what action to perform given the name
+;; and `gnus-uu-file-action-list'. Returns either nil if no action is
+;; found, or the name of the command to run if such a rule is found.
+(defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore)
+ (let ((action-list (copy-sequence file-action-list))
+ (case-fold-search t)
+ rule action)
+ (and
+ (unless no-ignore
+ (and (not
+ (and gnus-uu-ignore-files-by-name
+ (string-match gnus-uu-ignore-files-by-name file-name)))
+ (not
+ (and gnus-uu-ignore-files-by-type
+ (string-match gnus-uu-ignore-files-by-type
+ (or (gnus-uu-choose-action
+ file-name gnus-uu-ext-to-mime-list t)
+ ""))))))
+ (while (not (or (eq action-list ()) action))
+ (setq rule (car action-list))
+ (setq action-list (cdr action-list))
+ (when (string-match (car rule) file-name)
+ (setq action (cadr rule)))))
+ action))
+
+(defun gnus-uu-treat-archive (file-path)
+ ;; Unpacks an archive. Returns t if unpacking is successful.
+ (let ((did-unpack t)
+ action command dir)
+ (setq action (gnus-uu-choose-action
+ file-path (append gnus-uu-user-archive-rules
+ (if gnus-uu-ignore-default-archive-rules
+ nil
+ gnus-uu-default-archive-rules))))
+
+ (when (not action)
+ (error "No unpackers for the file %s" file-path))
+
+ (string-match "/[^/]*$" file-path)
+ (setq dir (substring file-path 0 (match-beginning 0)))
+
+ (when (member action gnus-uu-destructive-archivers)
+ (copy-file file-path (concat file-path "~") t))
+
+ (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path)))
+
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+ (erase-buffer))
+
+ (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
+
+ (if (= 0 (call-process shell-file-name nil
+ (get-buffer-create gnus-uu-output-buffer-name)
+ nil shell-command-switch command))
+ (message "")
+ (gnus-message 2 "Error during unpacking of archive")
+ (setq did-unpack nil))
+
+ (when (member action gnus-uu-destructive-archivers)
+ (rename-file (concat file-path "~") file-path t))
+
+ did-unpack))
+
+(defun gnus-uu-dir-files (dir)
+ (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$"))
+ files file)
+ (while dirs
+ (if (file-directory-p (setq file (car dirs)))
+ (setq files (append files (gnus-uu-dir-files file)))
+ (push file files))
+ (setq dirs (cdr dirs)))
+ files))
+
+(defun gnus-uu-unpack-files (files &optional ignore)
+ ;; Go through FILES and look for files to unpack.
+ (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir))
+ (ofiles files)
+ file did-unpack)
+ (while files
+ (setq file (cdr (assq 'name (car files))))
+ (when (and (not (member file ignore))
+ (equal (gnus-uu-get-action (file-name-nondirectory file))
+ "gnus-uu-archive"))
+ (push file did-unpack)
+ (unless (gnus-uu-treat-archive file)
+ (gnus-message 2 "Error during unpacking of %s" file))
+ (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir))
+ (nfiles newfiles))
+ (while nfiles
+ (unless (member (car nfiles) totfiles)
+ (push (list (cons 'name (car nfiles))
+ (cons 'original file))
+ ofiles))
+ (setq nfiles (cdr nfiles)))
+ (setq totfiles newfiles)))
+ (setq files (cdr files)))
+ (if did-unpack
+ (gnus-uu-unpack-files ofiles (append did-unpack ignore))
+ ofiles)))
+
+(defun gnus-uu-ls-r (dir)
+ (let* ((files (gnus-uu-directory-files dir t))
+ (ofiles files))
+ (while files
+ (when (file-directory-p (car files))
+ (setq ofiles (delete (car files) ofiles))
+ (setq ofiles (append ofiles (gnus-uu-ls-r (car files)))))
+ (setq files (cdr files)))
+ ofiles))
+
+;; Various stuff
+
+(defun gnus-uu-directory-files (dir &optional full)
+ (let (files out file)
+ (setq files (directory-files dir full))
+ (while files
+ (setq file (car files))
+ (setq files (cdr files))
+ (unless (member (file-name-nondirectory file) '("." ".."))
+ (push file out)))
+ (setq out (nreverse out))
+ out))
+
+(defun gnus-uu-check-correct-stripped-uucode (start end)
+ (save-excursion
+ (let (found beg length)
+ (if (not gnus-uu-correct-stripped-uucode)
+ ()
+ (goto-char start)
+
+ (if (re-search-forward " \\|`" end t)
+ (progn
+ (goto-char start)
+ (while (not (eobp))
+ (progn
+ (when (looking-at "\n")
+ (replace-match ""))
+ (forward-line 1))))
+
+ (while (not (eobp))
+ (if (looking-at (concat gnus-uu-begin-string "\\|"
+ gnus-uu-end-string))
+ ()
+ (when (not found)
+ (beginning-of-line)
+ (setq beg (point))
+ (end-of-line)
+ (setq length (- (point) beg)))
+ (setq found t)
+ (beginning-of-line)
+ (setq beg (point))
+ (end-of-line)
+ (when (not (= length (- (point) beg)))
+ (insert (make-string (- length (- (point) beg)) ? ))))
+ (forward-line 1)))))))
+
+(defvar gnus-uu-tmp-alist nil)
+
+(defun gnus-uu-initialize (&optional scan)
+ (let (entry)
+ (if (and (not scan)
+ (when (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist))
+ (if (file-exists-p (cdr entry))
+ (setq gnus-uu-work-dir (cdr entry))
+ (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist))
+ nil)))
+ t
+ (setq gnus-uu-tmp-dir (file-name-as-directory
+ (expand-file-name gnus-uu-tmp-dir)))
+ (if (not (file-directory-p gnus-uu-tmp-dir))
+ (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir)
+ (when (not (file-writable-p gnus-uu-tmp-dir))
+ (error "Temp directory %s can't be written to"
+ gnus-uu-tmp-dir)))
+
+ (setq gnus-uu-work-dir
+ (make-temp-name (concat gnus-uu-tmp-dir "gnus")))
+ (gnus-make-directory gnus-uu-work-dir)
+ (set-file-modes gnus-uu-work-dir 448)
+ (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
+ (push (cons gnus-newsgroup-name gnus-uu-work-dir)
+ gnus-uu-tmp-alist))))
+
+
+;; Kills the temporary uu buffers, kills any processes, etc.
+(defun gnus-uu-clean-up ()
+ (let (buf)
+ (and gnus-uu-uudecode-process
+ (memq (process-status (or gnus-uu-uudecode-process "nevair"))
+ '(stop run))
+ (delete-process gnus-uu-uudecode-process))
+ (when (setq buf (get-buffer gnus-uu-output-buffer-name))
+ (kill-buffer buf))))
+
+(defun gnus-quote-arg-for-sh-or-csh (arg)
+ (let ((pos 0) new-pos accum)
+ ;; *** bug: we don't handle newline characters properly
+ (while (setq new-pos (string-match "[!`\"$\\& \t{}]" arg pos))
+ (push (substring arg pos new-pos) accum)
+ (push "\\" accum)
+ (push (list (aref arg new-pos)) accum)
+ (setq pos (1+ new-pos)))
+ (if (= pos 0)
+ arg
+ (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
+
+;; Inputs an action and a filename and returns a full command, making sure
+;; that the filename will be treated as a single argument when the shell
+;; executes the command.
+(defun gnus-uu-command (action file)
+ (let ((quoted-file (gnus-quote-arg-for-sh-or-csh file)))
+ (if (string-match "%s" action)
+ (format action quoted-file)
+ (concat action " " quoted-file))))
+
+(defun gnus-uu-delete-work-dir (&optional dir)
+ "Delete recursively all files and directories under `gnus-uu-work-dir'."
+ (if dir
+ (gnus-message 7 "Deleting directory %s..." dir)
+ (setq dir gnus-uu-work-dir))
+ (when (and dir
+ (file-exists-p dir))
+ (let ((files (directory-files dir t nil t))
+ file)
+ (while (setq file (pop files))
+ (unless (member (file-name-nondirectory file) '("." ".."))
+ (if (file-directory-p file)
+ (gnus-uu-delete-work-dir file)
+ (gnus-message 9 "Deleting file %s..." file)
+ (delete-file file))))
+ (delete-directory dir)))
+ (gnus-message 7 ""))
+
+;; Initializing
+
+(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up)
+(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir)
+
+\f
+
+;;;
+;;; uuencoded posting
+;;;
+
+;; Any function that is to be used as and encoding method will take two
+;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg"
+;; and "spiral.jpg", respectively.) The function should return nil if
+;; the encoding wasn't successful.
+(defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode
+ "Function used for encoding binary files.
+There are three functions supplied with gnus-uu for encoding files:
+`gnus-uu-post-encode-uuencode', which does straight uuencoding;
+`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME
+headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with
+uuencode and adds MIME headers."
+ :group 'gnus-extract-post
+ :type '(radio (function-item gnus-uu-post-encode-uuencode)
+ (function-item gnus-uu-post-encode-mime)
+ (function-item gnus-uu-post-encode-mime-uuencode)
+ (function :tag "Other")))
+
+(defcustom gnus-uu-post-include-before-composing nil
+ "Non-nil means that gnus-uu will ask for a file to encode before you compose the article.
+If this variable is t, you can either include an encoded file with
+\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article."
+ :group 'gnus-extract-post
+ :type 'boolean)
+
+(defcustom gnus-uu-post-length 990
+ "Maximum length of an article.
+The encoded file will be split into how many articles it takes to
+post the entire file."
+ :group 'gnus-extract-post
+ :type 'integer)
+
+(defcustom gnus-uu-post-threaded nil
+ "Non-nil means that gnus-uu will post the encoded file in a thread.
+This may not be smart, as no other decoder I have seen are able to
+follow threads when collecting uuencoded articles. (Well, I have seen
+one package that does that - gnus-uu, but somehow, I don't think that
+counts...) The default is nil."
+ :group 'gnus-extract-post
+ :type 'boolean)
+
+(defcustom gnus-uu-post-separate-description t
+ "Non-nil means that the description will be posted in a separate article.
+The first article will typically be numbered (0/x). If this variable
+is nil, the description the user enters will be included at the
+beginning of the first article, which will be numbered (1/x). Default
+is t."
+ :group 'gnus-extract-post
+ :type 'boolean)
+
+(defvar gnus-uu-post-binary-separator "--binary follows this line--")
+(defvar gnus-uu-post-message-id nil)
+(defvar gnus-uu-post-inserted-file-name nil)
+(defvar gnus-uu-winconf-post-news nil)
+
+(defun gnus-uu-post-news ()
+ "Compose an article and post an encoded file."
+ (interactive)
+ (setq gnus-uu-post-inserted-file-name nil)
+ (setq gnus-uu-winconf-post-news (current-window-configuration))
+
+ (gnus-summary-post-news)
+
+ (use-local-map (copy-keymap (current-local-map)))
+ (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
+ (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
+ (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
+ (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article)
+
+ (when gnus-uu-post-include-before-composing
+ (save-excursion (setq gnus-uu-post-inserted-file-name
+ (gnus-uu-post-insert-binary)))))
+
+(defun gnus-uu-post-insert-binary-in-article ()
+ "Inserts an encoded file in the buffer.
+The user will be asked for a file name."
+ (interactive)
+ (save-excursion
+ (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))
+
+;; Encodes with uuencode and substitutes all spaces with backticks.
+(defun gnus-uu-post-encode-uuencode (path file-name)
+ (when (gnus-uu-post-encode-file "uuencode" path file-name)
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (re-search-forward " " nil t)
+ (replace-match "`"))
+ t))
+
+;; Encodes with uuencode and adds MIME headers.
+(defun gnus-uu-post-encode-mime-uuencode (path file-name)
+ (when (gnus-uu-post-encode-uuencode path file-name)
+ (gnus-uu-post-make-mime file-name "x-uue")
+ t))
+
+;; Encodes with base64 and adds MIME headers
+(defun gnus-uu-post-encode-mime (path file-name)
+ (when (gnus-uu-post-encode-file "mmencode" path file-name)
+ (gnus-uu-post-make-mime file-name "base64")
+ t))
+
+;; Adds MIME headers.
+(defun gnus-uu-post-make-mime (file-name encoding)
+ (goto-char (point-min))
+ (insert (format "Content-Type: %s; name=\"%s\"\n"
+ (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)
+ file-name))
+ (insert (format "Content-Transfer-Encoding: %s\n\n" encoding))
+ (save-restriction
+ (set-buffer gnus-message-buffer)
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line -1)
+ (narrow-to-region 1 (point))
+ (unless (mail-fetch-field "mime-version")
+ (widen)
+ (insert "MIME-Version: 1.0\n"))
+ (widen)))
+
+;; Encodes a file PATH with COMMAND, leaving the result in the
+;; current buffer.
+(defun gnus-uu-post-encode-file (command path file-name)
+ (= 0 (call-process shell-file-name nil t nil shell-command-switch
+ (format "%s %s %s" command path file-name))))
+
+(defun gnus-uu-post-news-inews ()
+ "Posts the composed news article and encoded file.
+If no file has been included, the user will be asked for a file."
+ (interactive)
+
+ (let (file-name)
+
+ (if gnus-uu-post-inserted-file-name
+ (setq file-name gnus-uu-post-inserted-file-name)
+ (setq file-name (gnus-uu-post-insert-binary)))
+
+ (gnus-uu-post-encoded file-name gnus-uu-post-threaded))
+ (setq gnus-uu-post-inserted-file-name nil)
+ (when gnus-uu-winconf-post-news
+ (set-window-configuration gnus-uu-winconf-post-news)))
+
+;; Asks for a file to encode, encodes it and inserts the result in
+;; the current buffer. Returns the file name the user gave.
+(defun gnus-uu-post-insert-binary ()
+ (let ((uuencode-buffer-name "*uuencode buffer*")
+ file-path uubuf file-name)
+
+ (setq file-path (read-file-name
+ "What file do you want to encode? "))
+ (when (not (file-exists-p file-path))
+ (error "%s: No such file" file-path))
+
+ (goto-char (point-max))
+ (insert (format "\n%s\n" gnus-uu-post-binary-separator))
+
+ (when (string-match "^~/" file-path)
+ (setq file-path (concat "$HOME" (substring file-path 1))))
+ (if (string-match "/[^/]*$" file-path)
+ (setq file-name (substring file-path (1+ (match-beginning 0))))
+ (setq file-name file-path))
+
+ (unwind-protect
+ (if (save-excursion
+ (set-buffer (setq uubuf
+ (get-buffer-create uuencode-buffer-name)))
+ (erase-buffer)
+ (funcall gnus-uu-post-encode-method file-path file-name))
+ (insert-buffer-substring uubuf)
+ (error "Encoding unsuccessful"))
+ (kill-buffer uubuf))
+ file-name))
+
+;; Posts the article and all of the encoded file.
+(defun gnus-uu-post-encoded (file-name &optional threaded)
+ (let ((send-buffer-name "*uuencode send buffer*")
+ (encoded-buffer-name "*encoded buffer*")
+ (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]")
+ (separator (concat mail-header-separator "\n\n"))
+ uubuf length parts header i end beg
+ beg-line minlen buf post-buf whole-len beg-binary end-binary)
+
+ (setq post-buf (current-buffer))
+
+ (goto-char (point-min))
+ (when (not (re-search-forward
+ (if gnus-uu-post-separate-description
+ (concat "^" (regexp-quote gnus-uu-post-binary-separator)
+ "$")
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ nil t))
+ (error "Internal error: No binary/header separator"))
+ (beginning-of-line)
+ (forward-line 1)
+ (setq beg-binary (point))
+ (setq end-binary (point-max))
+
+ (save-excursion
+ (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name)))
+ (erase-buffer)
+ (insert-buffer-substring post-buf beg-binary end-binary)
+ (goto-char (point-min))
+ (setq length (count-lines 1 (point-max)))
+ (setq parts (/ length gnus-uu-post-length))
+ (unless (< (% length gnus-uu-post-length) 4)
+ (incf parts)))
+
+ (when gnus-uu-post-separate-description
+ (forward-line -1))
+ (delete-region (point) (point-max))
+
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
+ (beginning-of-line)
+ (setq header (buffer-substring 1 (point)))
+
+ (goto-char (point-min))
+ (when gnus-uu-post-separate-description
+ (when (re-search-forward "^Subject: " nil t)
+ (end-of-line)
+ (insert (format " (0/%d)" parts)))
+ (save-excursion
+ (message-send))
+ (setq gnus-uu-post-message-id (message-fetch-field "message-id")))
+
+ (save-excursion
+ (setq i 1)
+ (setq beg 1)
+ (while (not (> i parts))
+ (set-buffer (get-buffer-create send-buffer-name))
+ (erase-buffer)
+ (insert header)
+ (when (and threaded gnus-uu-post-message-id)
+ (insert "References: " gnus-uu-post-message-id "\n"))
+ (insert separator)
+ (setq whole-len
+ (- 62 (length (format top-string "" file-name i parts ""))))
+ (when (> 1 (setq minlen (/ whole-len 2)))
+ (setq minlen 1))
+ (setq
+ beg-line
+ (format top-string
+ (make-string minlen ?-)
+ file-name i parts
+ (make-string
+ (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
+
+ (goto-char (point-min))
+ (when (re-search-forward "^Subject: " nil t)
+ (end-of-line)
+ (insert (format " (%d/%d)" i parts)))
+
+ (goto-char (point-max))
+ (save-excursion
+ (set-buffer uubuf)
+ (goto-char beg)
+ (if (= i parts)
+ (goto-char (point-max))
+ (forward-line gnus-uu-post-length))
+ (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4))
+ (forward-line -4))
+ (setq end (point)))
+ (insert-buffer-substring uubuf beg end)
+ (insert beg-line "\n")
+ (setq beg end)
+ (incf i)
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
+ (beginning-of-line)
+ (forward-line 2)
+ (when (re-search-forward
+ (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$")
+ nil t)
+ (replace-match "")
+ (forward-line 1))
+ (insert beg-line)
+ (insert "\n")
+ (let (message-sent-message-via)
+ (save-excursion
+ (message-send))
+ (setq gnus-uu-post-message-id
+ (concat (message-fetch-field "references") " "
+ (message-fetch-field "message-id"))))))
+
+ (gnus-kill-buffer send-buffer-name)
+ (gnus-kill-buffer encoded-buffer-name)
+
+ (when (not gnus-uu-post-separate-description)
+ (set-buffer-modified-p nil)
+ (when (fboundp 'bury-buffer)
+ (bury-buffer)))))
+
+(provide 'gnus-uu)
+
+;; gnus-uu.el ends here
--- /dev/null
+;;; gnus-vm.el --- vm interface for Gnus
+;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc.
+
+;; Author: Per Persson <pp@gnu.ai.mit.edu>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Major contributors:
+;; Christian Limpach <Christian.Limpach@nice.ch>
+;; Some code stolen from:
+;; Rick Sladkey <jrs@world.std.com>
+
+;;; Code:
+
+(require 'sendmail)
+(require 'message)
+(require 'gnus)
+(require 'gnus-msg)
+
+(eval-when-compile
+ (autoload 'vm-mode "vm")
+ (autoload 'vm-save-message "vm")
+ (autoload 'vm-forward-message "vm")
+ (autoload 'vm-reply "vm")
+ (autoload 'vm-mail "vm"))
+
+(defvar gnus-vm-inhibit-window-system nil
+ "Inhibit loading `win-vm' if using a window-system.
+Has to be set before gnus-vm is loaded.")
+
+(or gnus-vm-inhibit-window-system
+ (condition-case nil
+ (when window-system
+ (require 'win-vm))
+ (error nil)))
+
+(when (not (featurep 'vm))
+ (load "vm"))
+
+(defun gnus-vm-make-folder (&optional buffer)
+ (let ((article (or buffer (current-buffer)))
+ (tmp-folder (generate-new-buffer " *tmp-folder*"))
+ (start (point-min))
+ (end (point-max)))
+ (set-buffer tmp-folder)
+ (insert-buffer-substring article start end)
+ (goto-char (point-min))
+ (if (looking-at "^\\(From [^ ]+ \\).*$")
+ (replace-match (concat "\\1" (current-time-string)))
+ (insert "From " gnus-newsgroup-name " "
+ (current-time-string) "\n"))
+ (while (re-search-forward "\n\nFrom " nil t)
+ (replace-match "\n\n>From "))
+ ;; insert a newline, otherwise the last line gets lost
+ (goto-char (point-max))
+ (insert "\n")
+ (vm-mode)
+ tmp-folder))
+
+(defun gnus-summary-save-article-vm (&optional arg)
+ "Append the current article to a vm folder.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-vm))
+ (gnus-summary-save-article arg)))
+
+(defun gnus-summary-save-in-vm (&optional folder)
+ (interactive)
+ (setq folder
+ (gnus-read-save-file-name
+ "Save %s in VM folder:" folder
+ gnus-mail-save-name gnus-newsgroup-name
+ gnus-current-headers 'gnus-newsgroup-last-mail))
+ (gnus-eval-in-buffer-window gnus-original-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((vm-folder (gnus-vm-make-folder)))
+ (vm-save-message folder)
+ (kill-buffer vm-folder))))))
+
+(provide 'gnus-vm)
+
+;;; gnus-vm.el ends here.
--- /dev/null
+;;; gnus-win.el --- window configuration functions for Gnus
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+
+(defgroup gnus-windows nil
+ "Window configuration."
+ :group 'gnus)
+
+(defcustom gnus-use-full-window t
+ "*If non-nil, use the entire Emacs screen."
+ :group 'gnus-windows
+ :type 'boolean)
+
+(defvar gnus-window-configuration nil
+ "Obsolete variable. See `gnus-buffer-configuration'.")
+
+(defcustom gnus-window-min-width 2
+ "*Minimum width of Gnus buffers."
+ :group 'gnus-windows
+ :type 'integer)
+
+(defcustom gnus-window-min-height 1
+ "*Minimum height of Gnus buffers."
+ :group 'gnus-windows
+ :type 'integer)
+
+(defcustom gnus-always-force-window-configuration nil
+ "*If non-nil, always force the Gnus window configurations."
+ :group 'gnus-windows
+ :type 'boolean)
+
+(defvar gnus-buffer-configuration
+ '((group
+ (vertical 1.0
+ (group 1.0 point)
+ (if gnus-carpal '(group-carpal 4))))
+ (summary
+ (vertical 1.0
+ (summary 1.0 point)
+ (if gnus-carpal '(summary-carpal 4))))
+ (article
+ (cond
+ ((and gnus-use-picons
+ (eq gnus-picons-display-where 'picons))
+ '(frame 1.0
+ (vertical 1.0
+ (summary 0.25 point)
+ (if gnus-carpal '(summary-carpal 4))
+ (article 1.0))
+ (vertical ((height . 5) (width . 15)
+ (user-position . t)
+ (left . -1) (top . 1))
+ (picons 1.0))))
+ (gnus-use-trees
+ '(vertical 1.0
+ (summary 0.25 point)
+ (tree 0.25)
+ (article 1.0)))
+ (t
+ '(vertical 1.0
+ (summary 0.25 point)
+ (if gnus-carpal '(summary-carpal 4))
+ (article 1.0)))))
+ (server
+ (vertical 1.0
+ (server 1.0 point)
+ (if gnus-carpal '(server-carpal 2))))
+ (browse
+ (vertical 1.0
+ (browse 1.0 point)
+ (if gnus-carpal '(browse-carpal 2))))
+ (message
+ (vertical 1.0
+ (message 1.0 point)))
+ (pick
+ (vertical 1.0
+ (article 1.0 point)))
+ (info
+ (vertical 1.0
+ (info 1.0 point)))
+ (summary-faq
+ (vertical 1.0
+ (summary 0.25)
+ (faq 1.0 point)))
+ (edit-article
+ (vertical 1.0
+ (article 1.0 point)))
+ (edit-form
+ (vertical 1.0
+ (group 0.5)
+ (edit-form 1.0 point)))
+ (edit-score
+ (vertical 1.0
+ (summary 0.25)
+ (edit-score 1.0 point)))
+ (post
+ (vertical 1.0
+ (post 1.0 point)))
+ (reply
+ (vertical 1.0
+ (article-copy 0.5)
+ (message 1.0 point)))
+ (forward
+ (vertical 1.0
+ (message 1.0 point)))
+ (reply-yank
+ (vertical 1.0
+ (message 1.0 point)))
+ (mail-bounce
+ (vertical 1.0
+ (article 0.5)
+ (message 1.0 point)))
+ (pipe
+ (vertical 1.0
+ (summary 0.25 point)
+ (if gnus-carpal '(summary-carpal 4))
+ ("*Shell Command Output*" 1.0)))
+ (bug
+ (vertical 1.0
+ ("*Gnus Help Bug*" 0.5)
+ ("*Gnus Bug*" 1.0 point)))
+ (score-trace
+ (vertical 1.0
+ (summary 0.5 point)
+ ("*Score Trace*" 1.0)))
+ (score-words
+ (vertical 1.0
+ (summary 0.5 point)
+ ("*Score Words*" 1.0)))
+ (category
+ (vertical 1.0
+ (category 1.0)))
+ (compose-bounce
+ (vertical 1.0
+ (article 0.5)
+ (message 1.0 point))))
+ "Window configuration for all possible Gnus buffers.
+See the Gnus manual for an explanation of the syntax used.")
+
+(defvar gnus-window-to-buffer
+ '((group . gnus-group-buffer)
+ (summary . gnus-summary-buffer)
+ (article . gnus-article-buffer)
+ (server . gnus-server-buffer)
+ (browse . "*Gnus Browse Server*")
+ (edit-group . gnus-group-edit-buffer)
+ (edit-form . gnus-edit-form-buffer)
+ (edit-server . gnus-server-edit-buffer)
+ (group-carpal . gnus-carpal-group-buffer)
+ (summary-carpal . gnus-carpal-summary-buffer)
+ (server-carpal . gnus-carpal-server-buffer)
+ (browse-carpal . gnus-carpal-browse-buffer)
+ (edit-score . gnus-score-edit-buffer)
+ (message . gnus-message-buffer)
+ (mail . gnus-message-buffer)
+ (post-news . gnus-message-buffer)
+ (faq . gnus-faq-buffer)
+ (picons . "*Picons*")
+ (tree . gnus-tree-buffer)
+ (score-trace . "*Score Trace*")
+ (info . gnus-info-buffer)
+ (category . gnus-category-buffer)
+ (article-copy . gnus-article-copy)
+ (draft . gnus-draft-buffer))
+ "Mapping from short symbols to buffer names or buffer variables.")
+
+;;; Internal variables.
+
+(defvar gnus-current-window-configuration nil
+ "The most recently set window configuration.")
+
+(defvar gnus-created-frames nil)
+
+(defun gnus-kill-gnus-frames ()
+ "Kill all frames Gnus has created."
+ (while gnus-created-frames
+ (when (frame-live-p (car gnus-created-frames))
+ ;; We slap a condition-case around this `delete-frame' to ensure
+ ;; against errors if we try do delete the single frame that's left.
+ (ignore-errors
+ (delete-frame (car gnus-created-frames))))
+ (pop gnus-created-frames)))
+
+(defun gnus-window-configuration-element (list)
+ (while (and list
+ (not (assq (car list) gnus-window-configuration)))
+ (pop list))
+ (cadr (assq (car list) gnus-window-configuration)))
+
+(defun gnus-windows-old-to-new (setting)
+ ;; First we take care of the really, really old Gnus 3 actions.
+ (when (symbolp setting)
+ (setq setting
+ ;; Take care of ooold GNUS 3.x values.
+ (cond ((eq setting 'SelectArticle) 'article)
+ ((memq setting '(SelectNewsgroup SelectSubject ExpandSubject))
+ 'summary)
+ ((memq setting '(ExitNewsgroup)) 'group)
+ (t setting))))
+ (if (or (listp setting)
+ (not (and gnus-window-configuration
+ (memq setting '(group summary article)))))
+ setting
+ (let* ((elem
+ (cond
+ ((eq setting 'group)
+ (gnus-window-configuration-element
+ '(group newsgroups ExitNewsgroup)))
+ ((eq setting 'summary)
+ (gnus-window-configuration-element
+ '(summary SelectNewsgroup SelectSubject ExpandSubject)))
+ ((eq setting 'article)
+ (gnus-window-configuration-element
+ '(article SelectArticle)))))
+ (total (apply '+ elem))
+ (types '(group summary article))
+ (pbuf (if (eq setting 'newsgroups) 'group 'summary))
+ (i 0)
+ perc out)
+ (while (< i 3)
+ (or (not (numberp (nth i elem)))
+ (zerop (nth i elem))
+ (progn
+ (setq perc (if (= i 2)
+ 1.0
+ (/ (float (nth i elem)) total)))
+ (push (if (eq pbuf (nth i types))
+ (list (nth i types) perc 'point)
+ (list (nth i types) perc))
+ out)))
+ (incf i))
+ `(vertical 1.0 ,@(nreverse out)))))
+
+;;;###autoload
+(defun gnus-add-configuration (conf)
+ "Add the window configuration CONF to `gnus-buffer-configuration'."
+ (setq gnus-buffer-configuration
+ (cons conf (delq (assq (car conf) gnus-buffer-configuration)
+ gnus-buffer-configuration))))
+
+(defvar gnus-frame-list nil)
+
+(defun gnus-configure-frame (split &optional window)
+ "Split WINDOW according to SPLIT."
+ (unless window
+ (setq window (get-buffer-window (current-buffer))))
+ (select-window window)
+ ;; This might be an old-stylee buffer config.
+ (when (vectorp split)
+ (setq split (append split nil)))
+ (when (or (consp (car split))
+ (vectorp (car split)))
+ (push 1.0 split)
+ (push 'vertical split))
+ ;; The SPLIT might be something that is to be evaled to
+ ;; return a new SPLIT.
+ (while (and (not (assq (car split) gnus-window-to-buffer))
+ (gnus-functionp (car split)))
+ (setq split (eval split)))
+ (let* ((type (car split))
+ (subs (cddr split))
+ (len (if (eq type 'horizontal) (window-width) (window-height)))
+ (total 0)
+ (window-min-width (or gnus-window-min-width window-min-width))
+ (window-min-height (or gnus-window-min-height window-min-height))
+ s result new-win rest comp-subs size sub)
+ (cond
+ ;; Nothing to do here.
+ ((null split))
+ ;; Don't switch buffers.
+ ((null type)
+ (and (memq 'point split) window))
+ ;; This is a buffer to be selected.
+ ((not (memq type '(frame horizontal vertical)))
+ (let ((buffer (cond ((stringp type) type)
+ (t (cdr (assq type gnus-window-to-buffer)))))
+ buf)
+ (unless buffer
+ (error "Illegal buffer type: %s" type))
+ (unless (setq buf (get-buffer (if (symbolp buffer)
+ (symbol-value buffer) buffer)))
+ (setq buf (get-buffer-create (if (symbolp buffer)
+ (symbol-value buffer) buffer))))
+ (switch-to-buffer buf)
+ ;; We return the window if it has the `point' spec.
+ (and (memq 'point split) window)))
+ ;; This is a frame split.
+ ((eq type 'frame)
+ (unless gnus-frame-list
+ (setq gnus-frame-list (list (window-frame
+ (get-buffer-window (current-buffer))))))
+ (let ((i 0)
+ params frame fresult)
+ (while (< i (length subs))
+ ;; Frame parameter is gotten from the sub-split.
+ (setq params (cadr (elt subs i)))
+ ;; It should be a list.
+ (unless (listp params)
+ (setq params nil))
+ ;; Create a new frame?
+ (unless (setq frame (elt gnus-frame-list i))
+ (nconc gnus-frame-list (list (setq frame (make-frame params))))
+ (push frame gnus-created-frames))
+ ;; Is the old frame still alive?
+ (unless (frame-live-p frame)
+ (setcar (nthcdr i gnus-frame-list)
+ (setq frame (make-frame params))))
+ ;; Select the frame in question and do more splits there.
+ (select-frame frame)
+ (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
+ (incf i))
+ ;; Select the frame that has the selected buffer.
+ (when fresult
+ (select-frame (window-frame fresult)))))
+ ;; This is a normal split.
+ (t
+ (when (> (length subs) 0)
+ ;; First we have to compute the sizes of all new windows.
+ (while subs
+ (setq sub (append (pop subs) nil))
+ (while (and (not (assq (car sub) gnus-window-to-buffer))
+ (gnus-functionp (car sub)))
+ (setq sub (eval sub)))
+ (when sub
+ (push sub comp-subs)
+ (setq size (cadar comp-subs))
+ (cond ((equal size 1.0)
+ (setq rest (car comp-subs))
+ (setq s 0))
+ ((floatp size)
+ (setq s (floor (* size len))))
+ ((integerp size)
+ (setq s size))
+ (t
+ (error "Illegal size: %s" size)))
+ ;; Try to make sure that we are inside the safe limits.
+ (cond ((zerop s))
+ ((eq type 'horizontal)
+ (setq s (max s window-min-width)))
+ ((eq type 'vertical)
+ (setq s (max s window-min-height))))
+ (setcar (cdar comp-subs) s)
+ (incf total s)))
+ ;; Take care of the "1.0" spec.
+ (if rest
+ (setcar (cdr rest) (- len total))
+ (error "No 1.0 specs in %s" split))
+ ;; The we do the actual splitting in a nice recursive
+ ;; fashion.
+ (setq comp-subs (nreverse comp-subs))
+ (while comp-subs
+ (if (null (cdr comp-subs))
+ (setq new-win window)
+ (setq new-win
+ (split-window window (cadar comp-subs)
+ (eq type 'horizontal))))
+ (setq result (or (gnus-configure-frame
+ (car comp-subs) window)
+ result))
+ (select-window new-win)
+ (setq window new-win)
+ (setq comp-subs (cdr comp-subs))))
+ ;; Return the proper window, if any.
+ (when result
+ (select-window result))))))
+
+(defvar gnus-frame-split-p nil)
+
+(defun gnus-configure-windows (setting &optional force)
+ (setq gnus-current-window-configuration setting)
+ (setq force (or force gnus-always-force-window-configuration))
+ (setq setting (gnus-windows-old-to-new setting))
+ (let ((split (if (symbolp setting)
+ (cadr (assq setting gnus-buffer-configuration))
+ setting))
+ all-visible)
+
+ (setq gnus-frame-split-p nil)
+
+ (unless split
+ (error "No such setting: %s" setting))
+
+ (if (and (setq all-visible (gnus-all-windows-visible-p split))
+ (not force))
+ ;; All the windows mentioned are already visible, so we just
+ ;; put point in the assigned buffer, and do not touch the
+ ;; winconf.
+ (select-window all-visible)
+
+ ;; Either remove all windows or just remove all Gnus windows.
+ (let ((frame (selected-frame)))
+ (unwind-protect
+ (if gnus-use-full-window
+ ;; We want to remove all other windows.
+ (if (not gnus-frame-split-p)
+ ;; This is not a `frame' split, so we ignore the
+ ;; other frames.
+ (delete-other-windows)
+ ;; This is a `frame' split, so we delete all windows
+ ;; on all frames.
+ (gnus-delete-windows-in-gnusey-frames))
+ ;; Just remove some windows.
+ (gnus-remove-some-windows)
+ (switch-to-buffer nntp-server-buffer))
+ (select-frame frame)))
+
+ (switch-to-buffer nntp-server-buffer)
+ (gnus-configure-frame split (get-buffer-window (current-buffer))))))
+
+(defun gnus-delete-windows-in-gnusey-frames ()
+ "Do a `delete-other-windows' in all frames that have Gnus windows."
+ (let ((buffers
+ (mapcar
+ (lambda (elem)
+ (if (symbolp (cdr elem))
+ (when (and (boundp (cdr elem))
+ (symbol-value (cdr elem)))
+ (get-buffer (symbol-value (cdr elem))))
+ (when (cdr elem)
+ (get-buffer (cdr elem)))))
+ gnus-window-to-buffer)))
+ (mapcar
+ (lambda (frame)
+ (unless (eq (cdr (assq 'minibuffer
+ (frame-parameters frame)))
+ 'only)
+ (select-frame frame)
+ (let (do-delete)
+ (walk-windows
+ (lambda (window)
+ (when (memq (window-buffer window) buffers)
+ (setq do-delete t))))
+ (when do-delete
+ (delete-other-windows)))))
+ (frame-list))))
+
+(defun gnus-all-windows-visible-p (split)
+ "Say whether all buffers in SPLIT are currently visible.
+In particular, the value returned will be the window that
+should have point."
+ (let ((stack (list split))
+ (all-visible t)
+ type buffer win buf)
+ (while (and (setq split (pop stack))
+ all-visible)
+ ;; Be backwards compatible.
+ (when (vectorp split)
+ (setq split (append split nil)))
+ (when (or (consp (car split))
+ (vectorp (car split)))
+ (push 1.0 split)
+ (push 'vertical split))
+ ;; The SPLIT might be something that is to be evaled to
+ ;; return a new SPLIT.
+ (while (and (not (assq (car split) gnus-window-to-buffer))
+ (gnus-functionp (car split)))
+ (setq split (eval split)))
+
+ (setq type (elt split 0))
+ (cond
+ ;; Nothing here.
+ ((null split) t)
+ ;; A buffer.
+ ((not (memq type '(horizontal vertical frame)))
+ (setq buffer (cond ((stringp type) type)
+ (t (cdr (assq type gnus-window-to-buffer)))))
+ (unless buffer
+ (error "Illegal buffer type: %s" type))
+ (when (setq buf (get-buffer (if (symbolp buffer)
+ (symbol-value buffer)
+ buffer)))
+ (setq win (get-buffer-window buf t)))
+ (if win
+ (when (memq 'point split)
+ (setq all-visible win))
+ (setq all-visible nil)))
+ (t
+ (when (eq type 'frame)
+ (setq gnus-frame-split-p t))
+ (setq stack (append (cddr split) stack)))))
+ (unless (eq all-visible t)
+ all-visible)))
+
+(defun gnus-window-top-edge (&optional window)
+ (nth 1 (window-edges window)))
+
+(defun gnus-remove-some-windows ()
+ (let ((buffers gnus-window-to-buffer)
+ buf bufs lowest-buf lowest)
+ (save-excursion
+ ;; Remove windows on all known Gnus buffers.
+ (while buffers
+ (setq buf (cdar buffers))
+ (when (symbolp buf)
+ (setq buf (and (boundp buf) (symbol-value buf))))
+ (and buf
+ (get-buffer-window buf)
+ (progn
+ (push buf bufs)
+ (pop-to-buffer buf)
+ (when (or (not lowest)
+ (< (gnus-window-top-edge) lowest))
+ (setq lowest (gnus-window-top-edge))
+ (setq lowest-buf buf))))
+ (setq buffers (cdr buffers)))
+ ;; Remove windows on *all* summary buffers.
+ (walk-windows
+ (lambda (win)
+ (let ((buf (window-buffer win)))
+ (when (string-match "^\\*Summary" (buffer-name buf))
+ (push buf bufs)
+ (pop-to-buffer buf)
+ (when (or (not lowest)
+ (< (gnus-window-top-edge) lowest))
+ (setq lowest-buf buf)
+ (setq lowest (gnus-window-top-edge)))))))
+ (when lowest-buf
+ (pop-to-buffer lowest-buf)
+ (switch-to-buffer nntp-server-buffer))
+ (while bufs
+ (when (not (eq (car bufs) lowest-buf))
+ (delete-windows-on (car bufs)))
+ (setq bufs (cdr bufs))))))
+
+(provide 'gnus-win)
+
+;;; gnus-win.el ends here
--- /dev/null
+;;; gnus-xmas.el --- Gnus functions for XEmacs
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'text-props)
+(defvar menu-bar-mode (featurep 'menubar))
+(require 'messagexmas)
+
+(defgroup gnus-xmas nil
+ "XEmacsoid support for Gnus"
+ :group 'gnus)
+
+(defcustom gnus-xmas-glyph-directory nil
+ "*Directory where Gnus logos and icons are located.
+If this variable is nil, Gnus will try to locate the directory
+automatically."
+ :type '(choice (const :tag "autodetect" nil)
+ directory)
+ :group 'gnus-xmas)
+
+(defvar gnus-xmas-logo-color-alist
+ '((flame "#cc3300" "#ff2200")
+ (pine "#c0cc93" "#f8ffb8")
+ (moss "#a1cc93" "#d2ffb8")
+ (irish "#04cc90" "#05ff97")
+ (sky "#049acc" "#05deff")
+ (tin "#6886cc" "#82b6ff")
+ (velvet "#7c68cc" "#8c82ff")
+ (grape "#b264cc" "#cf7df")
+ (labia "#cc64c2" "#fd7dff")
+ (berry "#cc6485" "#ff7db5")
+ (neutral "#b4b4b4" "#878787")
+ (september "#bf9900" "#ffcc00"))
+ "Color alist used for the Gnus logo.")
+
+(defcustom gnus-xmas-logo-color-style 'moss
+ "Color styles used for the Gnus logo."
+ :type '(choice (const flame) (const pine) (const moss)
+ (const irish) (const sky) (const tin)
+ (const velvet) (const grape) (const labia)
+ (const berry) (const neutral) (const september))
+ :group 'gnus-xmas)
+
+(defvar gnus-xmas-logo-colors
+ (cdr (assq gnus-xmas-logo-color-style gnus-xmas-logo-color-alist))
+ "Colors used for the Gnus logo.")
+
+(defcustom gnus-article-x-face-command
+ (if (or (featurep 'xface)
+ (featurep 'xpm))
+ 'gnus-xmas-article-display-xface
+ "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -")
+ "String or function to be executed to display an X-Face header.
+If it is a string, the command will be executed in a sub-shell
+asynchronously. The compressed face will be piped to this command."
+ :type '(choice string function))
+
+;;; Internal variables.
+
+;; Don't warn about these undefined variables.
+
+(defvar gnus-group-mode-hook)
+(defvar gnus-summary-mode-hook)
+(defvar gnus-article-mode-hook)
+
+;;defined in gnus.el
+(defvar gnus-active-hashtb)
+(defvar gnus-article-buffer)
+(defvar gnus-auto-center-summary)
+(defvar gnus-buffer-list)
+(defvar gnus-current-headers)
+(defvar gnus-level-killed)
+(defvar gnus-level-zombie)
+(defvar gnus-newsgroup-bookmarks)
+(defvar gnus-newsgroup-dependencies)
+(defvar gnus-newsgroup-selected-overlay)
+(defvar gnus-newsrc-hashtb)
+(defvar gnus-read-mark)
+(defvar gnus-refer-article-method)
+(defvar gnus-reffed-article-number)
+(defvar gnus-unread-mark)
+(defvar gnus-version)
+(defvar gnus-view-pseudos)
+(defvar gnus-view-pseudos-separately)
+(defvar gnus-visual)
+(defvar gnus-zombie-list)
+;;defined in gnus-msg.el
+(defvar gnus-article-copy)
+(defvar gnus-check-before-posting)
+;;defined in gnus-vis.el
+(defvar gnus-article-button-face)
+(defvar gnus-article-mouse-face)
+(defvar gnus-summary-selected-face)
+(defvar gnus-group-reading-menu)
+(defvar gnus-group-group-menu)
+(defvar gnus-group-misc-menu)
+(defvar gnus-summary-article-menu)
+(defvar gnus-summary-thread-menu)
+(defvar gnus-summary-misc-menu)
+(defvar gnus-summary-post-menu)
+(defvar gnus-summary-kill-menu)
+(defvar gnus-article-article-menu)
+(defvar gnus-article-treatment-menu)
+(defvar gnus-mouse-2)
+(defvar standard-display-table)
+(defvar gnus-tree-minimize-window)
+
+(defun gnus-xmas-set-text-properties (start end props &optional buffer)
+ "You should NEVER use this function. It is ideologically blasphemous.
+It is provided only to ease porting of broken FSF Emacs programs."
+ (if (stringp buffer)
+ nil
+ (map-extents (lambda (extent ignored)
+ (remove-text-properties
+ start end
+ (list (extent-property extent 'text-prop) nil)
+ buffer)
+ nil)
+ buffer start end nil nil 'text-prop)
+ (gnus-add-text-properties start end props buffer)))
+
+(defun gnus-xmas-highlight-selected-summary ()
+ ;; Highlight selected article in summary buffer
+ (when gnus-summary-selected-face
+ (when gnus-newsgroup-selected-overlay
+ (delete-extent gnus-newsgroup-selected-overlay))
+ (setq gnus-newsgroup-selected-overlay
+ (make-extent (gnus-point-at-bol) (gnus-point-at-eol)))
+ (set-extent-face gnus-newsgroup-selected-overlay
+ gnus-summary-selected-face)))
+
+(defcustom gnus-xmas-force-redisplay nil
+ "If non-nil, force a redisplay before recentering the summary buffer.
+This is ugly, but it works around a bug in `window-displayed-height'."
+ :type 'boolean
+ :group 'gnus-xmas)
+
+(defun gnus-xmas-switch-horizontal-scrollbar-off ()
+ (when (featurep 'scrollbar)
+ (set-specifier scrollbar-height (cons (current-buffer) 0))))
+
+(defun gnus-xmas-summary-recenter ()
+ "\"Center\" point in the summary window.
+If `gnus-auto-center-summary' is nil, or the article buffer isn't
+displayed, no centering will be performed."
+ ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
+ ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
+ ;; Force redisplay to get properly computed window height.
+ (when gnus-xmas-force-redisplay
+ (sit-for 0))
+ (when gnus-auto-center-summary
+ (let* ((height (if (fboundp 'window-displayed-height)
+ (window-displayed-height)
+ (- (window-height) 2)))
+ (top (cond ((< height 4) 0)
+ ((< height 7) 1)
+ (t 2)))
+ (bottom (save-excursion (goto-char (point-max))
+ (forward-line (- height))
+ (point)))
+ (window (get-buffer-window (current-buffer))))
+ (when (get-buffer-window gnus-article-buffer)
+ ;; Only do recentering when the article buffer is displayed,
+ ;; Set the window start to either `bottom', which is the biggest
+ ;; possible valid number, or the second line from the top,
+ ;; whichever is the least.
+ (set-window-start
+ window (min bottom (save-excursion (forward-line (- top)) (point)))))
+ ;; Do horizontal recentering while we're at it.
+ (when (and (get-buffer-window (current-buffer) t)
+ (not (eq gnus-auto-center-summary 'vertical)))
+ (let ((selected (selected-window)))
+ (select-window (get-buffer-window (current-buffer) t))
+ (gnus-summary-position-point)
+ (gnus-horizontal-recenter)
+ (select-window selected))))))
+
+(defun gnus-xmas-summary-set-display-table ()
+ ;; Setup the display table -- like `gnus-summary-setup-display-table',
+ ;; but done in an XEmacsish way.
+ (let ((table (make-display-table))
+ (i 32))
+ ;; Nix out all the control chars...
+ (while (>= (setq i (1- i)) 0)
+ (aset table i [??]))
+ ;; ... but not newline and cr, of course. (cr is necessary for the
+ ;; selective display).
+ (aset table ?\n nil)
+ (aset table ?\r nil)
+ ;; We nix out any glyphs over 126 below ctl-arrow.
+ (let ((i (if (integerp ctl-arrow) ctl-arrow 160)))
+ (while (>= (setq i (1- i)) 127)
+ (unless (aref table i)
+ (aset table i [??]))))
+ ;; Can't use `set-specifier' because of a bug in 19.14 and earlier
+ (add-spec-to-specifier current-display-table table (current-buffer) nil)))
+
+(defun gnus-xmas-add-text-properties (start end props &optional object)
+ (add-text-properties start end props object)
+ (put-text-property start end 'start-closed nil object))
+
+(defun gnus-xmas-put-text-property (start end prop value &optional object)
+ (put-text-property start end prop value object)
+ (put-text-property start end 'start-closed nil object))
+
+(defun gnus-xmas-extent-start-open (point)
+ (map-extents (lambda (extent arg)
+ (set-extent-property extent 'start-open t))
+ nil point (min (1+ (point)) (point-max))))
+
+(defun gnus-xmas-article-push-button (event)
+ "Check text under the mouse pointer for a callback function.
+If the text under the mouse pointer has a `gnus-callback' property,
+call it with the value of the `gnus-data' text property."
+ (interactive "e")
+ (set-buffer (window-buffer (event-window event)))
+ (let* ((pos (event-closest-point event))
+ (data (get-text-property pos 'gnus-data))
+ (fun (get-text-property pos 'gnus-callback)))
+ (when fun
+ (funcall fun data))))
+
+(defun gnus-xmas-move-overlay (extent start end &optional buffer)
+ (set-extent-endpoints extent start end))
+
+;; Fixed by Christopher Davis <ckd@loiosh.kei.com>.
+(defun gnus-xmas-article-add-button (from to fun &optional data)
+ "Create a button between FROM and TO with callback FUN and data DATA."
+ (when gnus-article-button-face
+ (gnus-overlay-put (gnus-make-overlay from to)
+ 'face gnus-article-button-face))
+ (gnus-add-text-properties
+ from to
+ (nconc
+ (and gnus-article-mouse-face
+ (list 'mouse-face gnus-article-mouse-face))
+ (list 'gnus-callback fun)
+ (and data (list 'gnus-data data))
+ (list 'highlight t))))
+
+(defun gnus-xmas-window-top-edge (&optional window)
+ (nth 1 (window-pixel-edges window)))
+
+(defun gnus-xmas-tree-minimize ()
+ (when (and gnus-tree-minimize-window
+ (not (one-window-p)))
+ (let* ((window-min-height 2)
+ (height (1+ (count-lines (point-min) (point-max))))
+ (min (max (1- window-min-height) height))
+ (tot (if (numberp gnus-tree-minimize-window)
+ (min gnus-tree-minimize-window min)
+ min))
+ (win (get-buffer-window (current-buffer)))
+ (wh (and win (1- (window-height win)))))
+ (when (and win
+ (not (eq tot wh)))
+ (let ((selected (selected-window)))
+ (select-window win)
+ (enlarge-window (- tot wh))
+ (select-window selected))))))
+
+;; Select the lowest window on the frame.
+(defun gnus-xmas-appt-select-lowest-window ()
+ (let* ((lowest-window (selected-window))
+ (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges))))))
+ (last-window (previous-window))
+ (window-search t))
+ (while window-search
+ (let* ((this-window (next-window))
+ (next-bottom-edge (car (cdr (cdr (cdr
+ (window-pixel-edges
+ this-window)))))))
+ (when (< bottom-edge next-bottom-edge)
+ (setq bottom-edge next-bottom-edge)
+ (setq lowest-window this-window))
+
+ (select-window this-window)
+ (when (eq last-window this-window)
+ (select-window lowest-window)
+ (setq window-search nil))))))
+
+(defmacro gnus-xmas-menu-add (type &rest menus)
+ `(gnus-xmas-menu-add-1 ',type ',menus))
+(put 'gnus-xmas-menu-add 'lisp-indent-function 1)
+
+(defun gnus-xmas-menu-add-1 (type menus)
+ (when (and menu-bar-mode
+ (gnus-visual-p (intern (format "%s-menu" type)) 'menu))
+ (while menus
+ (easy-menu-add (symbol-value (pop menus))))))
+
+(defun gnus-xmas-group-menu-add ()
+ (gnus-xmas-menu-add group
+ gnus-group-reading-menu gnus-group-group-menu gnus-group-misc-menu))
+
+(defun gnus-xmas-summary-menu-add ()
+ (gnus-xmas-menu-add summary
+ gnus-summary-misc-menu gnus-summary-kill-menu
+ gnus-summary-article-menu gnus-summary-thread-menu
+ gnus-summary-post-menu ))
+
+(defun gnus-xmas-article-menu-add ()
+ (gnus-xmas-menu-add article
+ gnus-article-article-menu gnus-article-treatment-menu))
+
+(defun gnus-xmas-score-menu-add ()
+ (gnus-xmas-menu-add score
+ gnus-score-menu))
+
+(defun gnus-xmas-pick-menu-add ()
+ (gnus-xmas-menu-add pick
+ gnus-pick-menu))
+
+(defun gnus-xmas-topic-menu-add ()
+ (gnus-xmas-menu-add topic
+ gnus-topic-menu))
+
+(defun gnus-xmas-binary-menu-add ()
+ (gnus-xmas-menu-add binary
+ gnus-binary-menu))
+
+(defun gnus-xmas-tree-menu-add ()
+ (gnus-xmas-menu-add tree
+ gnus-tree-menu))
+
+(defun gnus-xmas-server-menu-add ()
+ (gnus-xmas-menu-add menu
+ gnus-server-server-menu gnus-server-connections-menu))
+
+(defun gnus-xmas-browse-menu-add ()
+ (gnus-xmas-menu-add browse
+ gnus-browse-menu))
+
+(defun gnus-xmas-grouplens-menu-add ()
+ (gnus-xmas-menu-add grouplens
+ gnus-grouplens-menu))
+
+(defun gnus-xmas-read-event-char ()
+ "Get the next event."
+ (let ((event (next-command-event)))
+ (sit-for 0)
+ ;; We junk all non-key events. Is this naughty?
+ (while (not (or (key-press-event-p event)
+ (button-press-event-p event)))
+ (dispatch-event event)
+ (setq event (next-command-event)))
+ (cons (and (key-press-event-p event)
+ (event-to-character event))
+ event)))
+
+(defun gnus-xmas-seconds-since-epoch (date)
+ "Return a floating point number that says how many seconds have lapsed between Jan 1 12:00:00 1970 and DATE."
+ (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti)))
+ (timezone-parse-date date)))
+ (ttime (mapcar (lambda (ti) (and ti (string-to-int ti)))
+ (timezone-parse-time
+ (aref (timezone-parse-date date) 3))))
+ (edate (mapcar (lambda (ti) (and ti (string-to-int ti)))
+ (timezone-parse-date "Jan 1 12:00:00 1970")))
+ (tday (- (timezone-absolute-from-gregorian
+ (nth 1 tdate) (nth 2 tdate) (nth 0 tdate))
+ (timezone-absolute-from-gregorian
+ (nth 1 edate) (nth 2 edate) (nth 0 edate)))))
+ (+ (nth 2 ttime)
+ (* (nth 1 ttime) 60)
+ (* (float (nth 0 ttime)) 60 60)
+ (* (float tday) 60 60 24))))
+
+(defun gnus-xmas-define ()
+ (setq gnus-mouse-2 [button2])
+
+ (unless (memq 'underline (face-list))
+ (and (fboundp 'make-face)
+ (funcall (intern "make-face") 'underline)))
+ ;; Must avoid calling set-face-underline-p directly, because it
+ ;; is a defsubst in emacs19, and will make the .elc files non
+ ;; portable!
+ (unless (face-differs-from-default-p 'underline)
+ (funcall (intern "set-face-underline-p") 'underline t))
+
+ (cond
+ ((fboundp 'char-or-char-int-p)
+ ;; Handle both types of marks for XEmacs-20.x.
+ (fset 'gnus-characterp 'char-or-char-int-p))
+ ;; V19 of XEmacs, probably.
+ (t
+ (fset 'gnus-characterp 'characterp)))
+
+ (fset 'gnus-make-overlay 'make-extent)
+ (fset 'gnus-overlay-put 'set-extent-property)
+ (fset 'gnus-move-overlay 'gnus-xmas-move-overlay)
+ (fset 'gnus-overlay-end 'extent-end-position)
+ (fset 'gnus-extent-detached-p 'extent-detached-p)
+ (fset 'gnus-add-text-properties 'gnus-xmas-add-text-properties)
+ (fset 'gnus-put-text-property 'gnus-xmas-put-text-property)
+ (fset 'gnus-deactivate-mark 'ignore)
+
+ (require 'text-props)
+ (if (and (<= emacs-major-version 19)
+ (< emacs-minor-version 14))
+ (fset 'gnus-set-text-properties 'gnus-xmas-set-text-properties))
+
+ (when (fboundp 'turn-off-scroll-in-place)
+ (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
+
+ (unless (boundp 'standard-display-table)
+ (setq standard-display-table nil))
+
+ (defvar gnus-mouse-face-prop 'highlight)
+
+ (unless (fboundp 'encode-time)
+ (defun encode-time (sec minute hour day month year &optional zone)
+ (let ((seconds
+ (gnus-xmas-seconds-since-epoch
+ (timezone-make-arpa-date
+ year month day (timezone-make-time-string hour minute sec)
+ zone))))
+ (list (floor (/ seconds (expt 2 16)))
+ (round (mod seconds (expt 2 16)))))))
+
+ (defun gnus-byte-code (func)
+ "Return a form that can be `eval'ed based on FUNC."
+ (let ((fval (symbol-function func)))
+ (if (byte-code-function-p fval)
+ (list 'funcall fval)
+ (cons 'progn (cdr (cdr fval))))))
+
+ (fset 'gnus-x-color-values
+ (if (fboundp 'x-color-values)
+ 'x-color-values
+ (lambda (color)
+ (color-instance-rgb-components
+ (make-color-instance color))))))
+
+(defun gnus-xmas-redefine ()
+ "Redefine lots of Gnus functions for XEmacs."
+ (fset 'gnus-summary-set-display-table 'gnus-xmas-summary-set-display-table)
+ (fset 'gnus-visual-turn-off-edit-menu 'identity)
+ (fset 'gnus-summary-recenter 'gnus-xmas-summary-recenter)
+ (fset 'gnus-extent-start-open 'gnus-xmas-extent-start-open)
+ (fset 'gnus-article-push-button 'gnus-xmas-article-push-button)
+ (fset 'gnus-article-add-button 'gnus-xmas-article-add-button)
+ (fset 'gnus-window-top-edge 'gnus-xmas-window-top-edge)
+ (fset 'gnus-read-event-char 'gnus-xmas-read-event-char)
+ (fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message)
+ (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize)
+ (fset 'gnus-appt-select-lowest-window
+ 'gnus-xmas-appt-select-lowest-window)
+ (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names)
+ (fset 'gnus-character-to-event 'character-to-event)
+ (fset 'gnus-mode-line-buffer-identification
+ 'gnus-xmas-mode-line-buffer-identification)
+ (fset 'gnus-key-press-event-p 'key-press-event-p)
+ (fset 'gnus-region-active-p 'region-active-p)
+
+ (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
+ (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
+ (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)
+ (add-hook 'gnus-score-mode-hook 'gnus-xmas-score-menu-add)
+
+ (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add)
+ (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add)
+ (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add)
+ (add-hook 'gnus-binary-mode-hook 'gnus-xmas-binary-menu-add)
+ (add-hook 'gnus-grouplens-mode-hook 'gnus-xmas-grouplens-menu-add)
+ (add-hook 'gnus-server-mode-hook 'gnus-xmas-server-menu-add)
+ (add-hook 'gnus-browse-mode-hook 'gnus-xmas-browse-menu-add)
+
+ (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar)
+ (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
+
+ (add-hook 'gnus-summary-mode-hook
+ 'gnus-xmas-switch-horizontal-scrollbar-off)
+ (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off))
+
+
+;;; XEmacs logo and toolbar.
+
+(defun gnus-xmas-group-startup-message (&optional x y)
+ "Insert startup message in current buffer."
+ ;; Insert the message.
+ (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus"))
+ (erase-buffer)
+ (cond
+ ((and (console-on-window-system-p)
+ (or (featurep 'xpm)
+ (featurep 'xbm)))
+ (let* ((logo-xpm (expand-file-name "gnus.xpm" gnus-xmas-glyph-directory))
+ (logo-xbm (expand-file-name "gnus.xbm" gnus-xmas-glyph-directory))
+ (glyph (make-glyph
+ `(,@(if (featurep 'xpm)
+ (list
+ (vector 'xpm
+ ':file logo-xpm
+ ':color-symbols
+ `(("thing" . ,(car gnus-xmas-logo-colors))
+ ("shadow" . ,(cadr gnus-xmas-logo-colors))
+ ("background" . ,(face-background 'default))))))
+ ,(vector 'xbm :file logo-xbm)
+ ,(vector 'nothing)))))
+ (insert " ")
+ (set-extent-begin-glyph (make-extent (point) (point)) glyph)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2)
+ ?\ ))
+ (forward-line 1)))
+ (goto-char (point-min))
+ (let* ((pheight (+ 20 (count-lines (point-min) (point-max))))
+ (wheight (window-height))
+ (rest (- wheight pheight)))
+ (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))))
+ (t
+ (insert
+ (format " %s
+ _ ___ _ _
+ _ ___ __ ___ __ _ ___
+ __ _ ___ __ ___
+ _ ___ _
+ _ _ __ _
+ ___ __ _
+ __ _
+ _ _ _
+ _ _ _
+ _ _ _
+ __ ___
+ _ _ _ _
+ _ _
+ _ _
+ _ _
+ _
+ __
+
+"
+ ""))
+ ;; And then hack it.
+ (gnus-indent-rigidly (point-min) (point-max)
+ (/ (max (- (window-width) (or x 46)) 0) 2))
+ (goto-char (point-min))
+ (forward-line 1)
+ (let* ((pheight (count-lines (point-min) (point-max)))
+ (wheight (window-height))
+ (rest (- wheight pheight)))
+ (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
+ ;; Paint it.
+ (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)))
+ (setq modeline-buffer-identification
+ (list (concat gnus-version ": *Group*")))
+ (set-buffer-modified-p t))
+
+
+;;; The toolbar.
+
+(defcustom gnus-use-toolbar (if (featurep 'toolbar)
+ 'default-toolbar
+ nil)
+ "*If nil, do not use a toolbar.
+If it is non-nil, it must be a toolbar. The five legal values are
+`default-toolbar', `top-toolbar', `bottom-toolbar',
+`right-toolbar', and `left-toolbar'."
+ :type '(choice (const default-toolbar)
+ (const top-toolbar) (const bottom-toolbar)
+ (const left-toolbar) (const right-toolbar)
+ (const :tag "no toolbar" nil))
+ :group 'gnus-xmas)
+
+(defvar gnus-group-toolbar
+ '([gnus-group-get-new-news gnus-group-get-new-news t "Get new news"]
+ [gnus-group-get-new-news-this-group
+ gnus-group-get-new-news-this-group t "Get new news in this group"]
+ [gnus-group-catchup-current
+ gnus-group-catchup-current t "Catchup group"]
+ [gnus-group-describe-group
+ gnus-group-describe-group t "Describe group"]
+ [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"]
+ [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"]
+ [gnus-group-kill-group gnus-group-kill-group t "Kill group"]
+ [gnus-group-exit gnus-group-exit t "Exit Gnus"]
+ )
+ "The group buffer toolbar.")
+
+(defvar gnus-summary-toolbar
+ '([gnus-summary-prev-unread
+ gnus-summary-prev-page-or-article t "Page up"]
+ [gnus-summary-next-unread
+ gnus-summary-next-page t "Page down"]
+ [gnus-summary-post-news
+ gnus-summary-post-news t "Post an article"]
+ [gnus-summary-followup-with-original
+ gnus-summary-followup-with-original t
+ "Post a followup and yank the original"]
+ [gnus-summary-followup
+ gnus-summary-followup t "Post a followup"]
+ [gnus-summary-reply-with-original
+ gnus-summary-reply-with-original t "Mail a reply and yank the original"]
+ [gnus-summary-reply
+ gnus-summary-reply t "Mail a reply"]
+ [gnus-summary-caesar-message
+ gnus-summary-caesar-message t "Rot 13"]
+ [gnus-uu-decode-uu
+ gnus-uu-decode-uu t "Decode uuencoded articles"]
+ [gnus-summary-save-article-file
+ gnus-summary-save-article-file t "Save article in file"]
+ [gnus-summary-save-article
+ gnus-summary-save-article t "Save article"]
+ [gnus-uu-post-news
+ gnus-uu-post-news t "Post a uuencoded article"]
+ [gnus-summary-cancel-article
+ gnus-summary-cancel-article t "Cancel article"]
+ [gnus-summary-catchup
+ gnus-summary-catchup t "Catchup"]
+ [gnus-summary-catchup-and-exit
+ gnus-summary-catchup-and-exit t "Catchup and exit"]
+ [gnus-summary-exit gnus-summary-exit t "Exit this summary"]
+ )
+ "The summary buffer toolbar.")
+
+(defvar gnus-summary-mail-toolbar
+ '(
+ [gnus-summary-prev-unread
+ gnus-summary-prev-unread-article t "Prev unread article"]
+ [gnus-summary-next-unread
+ gnus-summary-next-unread-article t "Next unread article"]
+ [gnus-summary-mail-reply gnus-summary-reply t "Reply"]
+; [gnus-summary-mail-get gnus-mail-get t "Message get"]
+ [gnus-summary-mail-originate gnus-summary-post-news t "Originate"]
+ [gnus-summary-mail-save gnus-summary-save-article t "Save"]
+ [gnus-summary-mail-copy gnus-summary-copy-article t "Copy message"]
+; [gnus-summary-mail-delete gnus-summary-delete-article t "Delete message"]
+ [gnus-summary-mail-forward gnus-summary-mail-forward t "Forward message"]
+; [gnus-summary-mail-spell gnus-mail-spell t "Spell"]
+; [gnus-summary-mail-help gnus-mail-help t "Message help"]
+ [gnus-summary-caesar-message
+ gnus-summary-caesar-message t "Rot 13"]
+ [gnus-uu-decode-uu
+ gnus-uu-decode-uu t "Decode uuencoded articles"]
+ [gnus-summary-save-article-file
+ gnus-summary-save-article-file t "Save article in file"]
+ [gnus-summary-save-article
+ gnus-summary-save-article t "Save article"]
+ [gnus-summary-catchup
+ gnus-summary-catchup t "Catchup"]
+ [gnus-summary-catchup-and-exit
+ gnus-summary-catchup-and-exit t "Catchup and exit"]
+ [gnus-summary-exit gnus-summary-exit t "Exit this summary"]
+ )
+ "The summary buffer mail toolbar.")
+
+(defun gnus-xmas-setup-group-toolbar ()
+ (and gnus-use-toolbar
+ (message-xmas-setup-toolbar gnus-group-toolbar nil "gnus")
+ (set-specifier (symbol-value gnus-use-toolbar)
+ (cons (current-buffer) gnus-group-toolbar))))
+
+(defun gnus-xmas-setup-summary-toolbar ()
+ (let ((bar (if (gnus-news-group-p gnus-newsgroup-name)
+ gnus-summary-toolbar gnus-summary-mail-toolbar)))
+ (and gnus-use-toolbar
+ (message-xmas-setup-toolbar bar nil "gnus")
+ (set-specifier (symbol-value gnus-use-toolbar)
+ (cons (current-buffer) bar)))))
+
+(defun gnus-xmas-mail-strip-quoted-names (address)
+ "Protect mail-strip-quoted-names from NIL input.
+XEmacs compatibility workaround."
+ (if (null address)
+ nil
+ (mail-strip-quoted-names address)))
+
+(defun gnus-xmas-call-region (command &rest args)
+ (apply
+ 'call-process-region (point-min) (point-max) command t '(t nil) nil
+ args))
+
+(defface gnus-x-face '((t (:foreground "black" :background "white")))
+ "Face to show X face"
+ :group 'gnus-xmas)
+
+(defun gnus-xmas-article-display-xface (beg end)
+ "Display any XFace headers in the current article."
+ (save-excursion
+ (let ((xface-glyph
+ (cond ((featurep 'xface)
+ (make-glyph (vector 'xface :data
+ (concat "X-Face: "
+ (buffer-substring beg end)))))
+ ((featurep 'xpm)
+ (let ((cur (current-buffer)))
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert (format "%s" (buffer-substring beg end cur)))
+ (gnus-xmas-call-region "uncompface")
+ (goto-char (point-min))
+ (insert "/* Width=48, Height=48 */\n")
+ (gnus-xmas-call-region "icontopbm")
+ (gnus-xmas-call-region "ppmtoxpm")
+ (make-glyph
+ (vector 'xpm :data (buffer-string))))))
+ (t
+ (make-glyph [nothing])))))
+ (set-glyph-face xface-glyph 'gnus-x-face)
+ (goto-char (point-min))
+ (re-search-forward "^From:" nil t)
+ (set-extent-begin-glyph
+ (make-extent (point) (1+ (point))) xface-glyph))))
+
+;;(defvar gnus-xmas-pointer-glyph
+;; (progn
+;; (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory
+;; "gnus"))
+;; (let ((file-xpm (expand-file-name "gnus-pointer.xpm"
+;; gnus-xmas-glyph-directory))
+;; (file-xbm (expand-file-name "gnus-pointer.xbm"
+;; gnus-xmas-glyph-directory)))
+;; (make-pointer-glyph
+;; (list (vector 'xpm ':file file-xpm)
+;; (vector 'xbm ':file file-xbm))))))
+
+(defvar gnus-xmas-modeline-left-extent
+ (let ((ext (copy-extent modeline-buffer-id-left-extent)))
+; (set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
+ ext))
+
+(defvar gnus-xmas-modeline-right-extent
+ (let ((ext (copy-extent modeline-buffer-id-right-extent)))
+; (set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
+ ext))
+
+(defvar gnus-xmas-modeline-glyph
+ (progn
+ (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus"))
+ (let* ((file-xpm (expand-file-name "gnus-pointer.xpm"
+ gnus-xmas-glyph-directory))
+ (file-xbm (expand-file-name "gnus-pointer.xbm"
+ gnus-xmas-glyph-directory))
+ (glyph (make-glyph
+ ;; Gag gag gag.
+ `(
+ ,@(if (featurep 'xpm)
+ ;; Let's try a nifty XPM
+ (list (vector 'xpm ':file file-xpm)))
+ ;; Then a not-so-nifty XBM
+ ,(vector 'xbm ':file file-xbm)
+ ;; Then the simple string
+ ,(vector 'string ':data "Gnus:")))))
+ (set-glyph-face glyph 'modeline-buffer-id)
+ glyph)))
+
+(defun gnus-xmas-mode-line-buffer-identification (line)
+ (let ((line (car line))
+ chop)
+ (cond
+ ;; This is some weird type of id.
+ ((not (stringp line))
+ (list line))
+ ;; This is non-standard, so we just pass it through.
+ ((not (string-match "^Gnus:" line))
+ (list line))
+ ;; We have a standard line, so we colorize and glyphize it a bit.
+ (t
+ (setq chop (match-end 0))
+ (list
+ (if gnus-xmas-modeline-glyph
+ (cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph)
+ (cons gnus-xmas-modeline-left-extent (substring line 0 chop)))
+ (cons gnus-xmas-modeline-right-extent (substring line chop)))))))
+
+(defun gnus-xmas-splash ()
+ (when (eq (device-type) 'x)
+ (gnus-splash)))
+
+(provide 'gnus-xmas)
+
+;;; gnus-xmas.el ends here
--- /dev/null
+;;; gnus.el --- a newsreader for GNU Emacs
+;; Copyright (C) 1987,88,89,90,93,94,95,96,97 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval '(run-hooks 'gnus-load-hook))
+
+(eval-when-compile (require 'cl))
+
+(require 'custom)
+(require 'gnus-load)
+(require 'message)
+
+(defgroup gnus nil
+ "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
+ :group 'news
+ :group 'mail)
+
+(defgroup gnus-start nil
+ "Starting your favorite newsreader."
+ :group 'gnus)
+
+(defgroup gnus-start-server nil
+ "Server options at startup."
+ :group 'gnus-start)
+
+;; These belong to gnus-group.el.
+(defgroup gnus-group nil
+ "Group buffers."
+ :link '(custom-manual "(gnus)The Group Buffer")
+ :group 'gnus)
+
+(defgroup gnus-group-foreign nil
+ "Foreign groups."
+ :link '(custom-manual "(gnus)Foreign Groups")
+ :group 'gnus-group)
+
+(defgroup gnus-group-new nil
+ "Automatic subscription of new groups."
+ :group 'gnus-group)
+
+(defgroup gnus-group-levels nil
+ "Group levels."
+ :link '(custom-manual "(gnus)Group Levels")
+ :group 'gnus-group)
+
+(defgroup gnus-group-select nil
+ "Selecting a Group."
+ :link '(custom-manual "(gnus)Selecting a Group")
+ :group 'gnus-group)
+
+(defgroup gnus-group-listing nil
+ "Showing slices of the group list."
+ :link '(custom-manual "(gnus)Listing Groups")
+ :group 'gnus-group)
+
+(defgroup gnus-group-visual nil
+ "Sorting the group buffer."
+ :link '(custom-manual "(gnus)Group Buffer Format")
+ :group 'gnus-group
+ :group 'gnus-visual)
+
+(defgroup gnus-group-various nil
+ "Various group options."
+ :link '(custom-manual "(gnus)Scanning New Messages")
+ :group 'gnus-group)
+
+;; These belong to gnus-sum.el.
+(defgroup gnus-summary nil
+ "Summary buffers."
+ :link '(custom-manual "(gnus)The Summary Buffer")
+ :group 'gnus)
+
+(defgroup gnus-summary-exit nil
+ "Leaving summary buffers."
+ :link '(custom-manual "(gnus)Exiting the Summary Buffer")
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-marks nil
+ "Marks used in summary buffers."
+ :link '(custom-manual "(gnus)Marking Articles")
+ :group 'gnus-summary)
+
+(defgroup gnus-thread nil
+ "Ordering articles according to replies."
+ :link '(custom-manual "(gnus)Threading")
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-format nil
+ "Formatting of the summary buffer."
+ :link '(custom-manual "(gnus)Summary Buffer Format")
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-choose nil
+ "Choosing Articles."
+ :link '(custom-manual "(gnus)Choosing Articles")
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-maneuvering nil
+ "Summary movement commands."
+ :link '(custom-manual "(gnus)Summary Maneuvering")
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-mail nil
+ "Mail group commands."
+ :link '(custom-manual "(gnus)Mail Group Commands")
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-sort nil
+ "Sorting the summary buffer."
+ :link '(custom-manual "(gnus)Sorting")
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-visual nil
+ "Highlighting and menus in the summary buffer."
+ :link '(custom-manual "(gnus)Summary Highlighting")
+ :group 'gnus-visual
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-various nil
+ "Various summary buffer options."
+ :link '(custom-manual "(gnus)Various Summary Stuff")
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-pick nil
+ "Pick mode in the summary buffer."
+ :link '(custom-manual "(gnus)Pick and Read")
+ :prefix "gnus-pick-"
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-tree nil
+ "Tree display of threads in the summary buffer."
+ :link '(custom-manual "(gnus)Tree Display")
+ :prefix "gnus-tree-"
+ :group 'gnus-summary)
+
+;; Belongs to gnus-uu.el
+(defgroup gnus-extract-view nil
+ "Viewing extracted files."
+ :link '(custom-manual "(gnus)Viewing Files")
+ :group 'gnus-extract)
+
+;; Belongs to gnus-score.el
+(defgroup gnus-score nil
+ "Score and kill file handling."
+ :group 'gnus)
+
+(defgroup gnus-score-kill nil
+ "Kill files."
+ :group 'gnus-score)
+
+(defgroup gnus-score-adapt nil
+ "Adaptive score files."
+ :group 'gnus-score)
+
+(defgroup gnus-score-default nil
+ "Default values for score files."
+ :group 'gnus-score)
+
+(defgroup gnus-score-expire nil
+ "Expiring score rules."
+ :group 'gnus-score)
+
+(defgroup gnus-score-decay nil
+ "Decaying score rules."
+ :group 'gnus-score)
+
+(defgroup gnus-score-files nil
+ "Score and kill file names."
+ :group 'gnus-score
+ :group 'gnus-files)
+
+(defgroup gnus-score-various nil
+ "Various scoring and killing options."
+ :group 'gnus-score)
+
+;; Other
+(defgroup gnus-visual nil
+ "Options controling the visual fluff."
+ :group 'gnus
+ :group 'faces)
+
+(defgroup gnus-agent nil
+ "Offline support for Gnus."
+ :group 'gnus)
+
+(defgroup gnus-files nil
+ "Files used by Gnus."
+ :group 'gnus)
+
+(defgroup gnus-dribble-file nil
+ "Auto save file."
+ :link '(custom-manual "(gnus)Auto Save")
+ :group 'gnus-files)
+
+(defgroup gnus-newsrc nil
+ "Storing Gnus state."
+ :group 'gnus-files)
+
+(defgroup gnus-server nil
+ "Options related to newsservers and other servers used by Gnus."
+ :group 'gnus)
+
+(defgroup gnus-message '((message custom-group))
+ "Composing replies and followups in Gnus."
+ :group 'gnus)
+
+(defgroup gnus-meta nil
+ "Meta variables controling major portions of Gnus.
+In general, modifying these variables does not take affect until Gnus
+is restarted, and sometimes reloaded."
+ :group 'gnus)
+
+(defgroup gnus-various nil
+ "Other Gnus options."
+ :link '(custom-manual "(gnus)Various Various")
+ :group 'gnus)
+
+(defgroup gnus-exit nil
+ "Exiting gnus."
+ :link '(custom-manual "(gnus)Exiting Gnus")
+ :group 'gnus)
+
+(defconst gnus-version-number "0.11"
+ "Version number for this version of Gnus.")
+
+(defconst gnus-version (format "Quassia Gnus v%s" gnus-version-number)
+ "Version string for this version of Gnus.")
+
+(defcustom gnus-inhibit-startup-message nil
+ "If non-nil, the startup message will not be displayed.
+This variable is used before `.gnus.el' is loaded, so it should
+be set in `.emacs' instead."
+ :group 'gnus-start
+ :type 'boolean)
+
+(defcustom gnus-play-startup-jingle nil
+ "If non-nil, play the Gnus jingle at startup."
+ :group 'gnus-start
+ :type 'boolean)
+
+;;; Kludges to help the transition from the old `custom.el'.
+
+(unless (featurep 'gnus-xmas)
+ (defalias 'gnus-make-overlay 'make-overlay)
+ (defalias 'gnus-overlay-put 'overlay-put)
+ (defalias 'gnus-move-overlay 'move-overlay)
+ (defalias 'gnus-overlay-end 'overlay-end)
+ (defalias 'gnus-extent-detached-p 'ignore)
+ (defalias 'gnus-extent-start-open 'ignore)
+ (defalias 'gnus-set-text-properties 'set-text-properties)
+ (defalias 'gnus-group-remove-excess-properties 'ignore)
+ (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
+ (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
+ (defalias 'gnus-character-to-event 'identity)
+ (defalias 'gnus-add-text-properties 'add-text-properties)
+ (defalias 'gnus-put-text-property 'put-text-property)
+ (defalias 'gnus-mode-line-buffer-identification 'identity)
+ (defalias 'gnus-characterp 'numberp)
+ (defalias 'gnus-deactivate-mark 'deactivate-mark)
+ (defalias 'gnus-key-press-event-p 'numberp))
+
+;; The XEmacs people think this is evil, so it must go.
+(defun custom-face-lookup (&optional fg bg stipple bold italic underline)
+ "Lookup or create a face with specified attributes."
+ (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
+ (or fg "default")
+ (or bg "default")
+ (or stipple "default")
+ bold italic underline))))
+ (if (and (custom-facep name)
+ (fboundp 'make-face))
+ ()
+ (copy-face 'default name)
+ (when (and fg
+ (not (string-equal fg "default")))
+ (ignore-errors
+ (set-face-foreground name fg)))
+ (when (and bg
+ (not (string-equal bg "default")))
+ (ignore-errors
+ (set-face-background name bg)))
+ (when (and stipple
+ (not (string-equal stipple "default"))
+ (not (eq stipple 'custom:asis))
+ (fboundp 'set-face-stipple))
+ (set-face-stipple name stipple))
+ (when (and bold
+ (not (eq bold 'custom:asis)))
+ (ignore-errors
+ (make-face-bold name)))
+ (when (and italic
+ (not (eq italic 'custom:asis)))
+ (ignore-errors
+ (make-face-italic name)))
+ (when (and underline
+ (not (eq underline 'custom:asis)))
+ (ignore-errors
+ (set-face-underline-p name t))))
+ name))
+
+;; We define these group faces here to avoid the display
+;; update forced when creating new faces.
+
+(defface gnus-group-news-1-face
+ '((((class color)
+ (background dark))
+ (:foreground "PaleTurquoise" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "ForestGreen" :bold t))
+ (t
+ ()))
+ "Level 1 newsgroup face.")
+
+(defface gnus-group-news-1-empty-face
+ '((((class color)
+ (background dark))
+ (:foreground "PaleTurquoise"))
+ (((class color)
+ (background light))
+ (:foreground "ForestGreen"))
+ (t
+ ()))
+ "Level 1 empty newsgroup face.")
+
+(defface gnus-group-news-2-face
+ '((((class color)
+ (background dark))
+ (:foreground "turquoise" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "CadetBlue4" :bold t))
+ (t
+ ()))
+ "Level 2 newsgroup face.")
+
+(defface gnus-group-news-2-empty-face
+ '((((class color)
+ (background dark))
+ (:foreground "turquoise"))
+ (((class color)
+ (background light))
+ (:foreground "CadetBlue4"))
+ (t
+ ()))
+ "Level 2 empty newsgroup face.")
+
+(defface gnus-group-news-3-face
+ '((((class color)
+ (background dark))
+ (:bold t))
+ (((class color)
+ (background light))
+ (:bold t))
+ (t
+ ()))
+ "Level 3 newsgroup face.")
+
+(defface gnus-group-news-3-empty-face
+ '((((class color)
+ (background dark))
+ ())
+ (((class color)
+ (background light))
+ ())
+ (t
+ ()))
+ "Level 3 empty newsgroup face.")
+
+(defface gnus-group-news-low-face
+ '((((class color)
+ (background dark))
+ (:foreground "DarkTurquoise" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "DarkGreen" :bold t))
+ (t
+ ()))
+ "Low level newsgroup face.")
+
+(defface gnus-group-news-low-empty-face
+ '((((class color)
+ (background dark))
+ (:foreground "DarkTurquoise"))
+ (((class color)
+ (background light))
+ (:foreground "DarkGreen"))
+ (t
+ ()))
+ "Low level empty newsgroup face.")
+
+(defface gnus-group-mail-1-face
+ '((((class color)
+ (background dark))
+ (:foreground "aquamarine1" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "DeepPink3" :bold t))
+ (t
+ (:bold t)))
+ "Level 1 mailgroup face.")
+
+(defface gnus-group-mail-1-empty-face
+ '((((class color)
+ (background dark))
+ (:foreground "aquamarine1"))
+ (((class color)
+ (background light))
+ (:foreground "DeepPink3"))
+ (t
+ (:italic t :bold t)))
+ "Level 1 empty mailgroup face.")
+
+(defface gnus-group-mail-2-face
+ '((((class color)
+ (background dark))
+ (:foreground "aquamarine2" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "HotPink3" :bold t))
+ (t
+ (:bold t)))
+ "Level 2 mailgroup face.")
+
+(defface gnus-group-mail-2-empty-face
+ '((((class color)
+ (background dark))
+ (:foreground "aquamarine2"))
+ (((class color)
+ (background light))
+ (:foreground "HotPink3"))
+ (t
+ (:bold t)))
+ "Level 2 empty mailgroup face.")
+
+(defface gnus-group-mail-3-face
+ '((((class color)
+ (background dark))
+ (:foreground "aquamarine3" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "magenta4" :bold t))
+ (t
+ (:bold t)))
+ "Level 3 mailgroup face.")
+
+(defface gnus-group-mail-3-empty-face
+ '((((class color)
+ (background dark))
+ (:foreground "aquamarine3"))
+ (((class color)
+ (background light))
+ (:foreground "magenta4"))
+ (t
+ ()))
+ "Level 3 empty mailgroup face.")
+
+(defface gnus-group-mail-low-face
+ '((((class color)
+ (background dark))
+ (:foreground "aquamarine4" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "DeepPink4" :bold t))
+ (t
+ (:bold t)))
+ "Low level mailgroup face.")
+
+(defface gnus-group-mail-low-empty-face
+ '((((class color)
+ (background dark))
+ (:foreground "aquamarine4"))
+ (((class color)
+ (background light))
+ (:foreground "DeepPink4"))
+ (t
+ (:bold t)))
+ "Low level empty mailgroup face.")
+
+;; Summary mode faces.
+
+(defface gnus-summary-selected-face '((t
+ (:underline t)))
+ "Face used for selected articles.")
+
+(defface gnus-summary-cancelled-face
+ '((((class color))
+ (:foreground "yellow" :background "black")))
+ "Face used for cancelled articles.")
+
+(defface gnus-summary-high-ticked-face
+ '((((class color)
+ (background dark))
+ (:foreground "pink" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "firebrick" :bold t))
+ (t
+ (:bold t)))
+ "Face used for high interest ticked articles.")
+
+(defface gnus-summary-low-ticked-face
+ '((((class color)
+ (background dark))
+ (:foreground "pink" :italic t))
+ (((class color)
+ (background light))
+ (:foreground "firebrick" :italic t))
+ (t
+ (:italic t)))
+ "Face used for low interest ticked articles.")
+
+(defface gnus-summary-normal-ticked-face
+ '((((class color)
+ (background dark))
+ (:foreground "pink"))
+ (((class color)
+ (background light))
+ (:foreground "firebrick"))
+ (t
+ ()))
+ "Face used for normal interest ticked articles.")
+
+(defface gnus-summary-high-ancient-face
+ '((((class color)
+ (background dark))
+ (:foreground "SkyBlue" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "RoyalBlue" :bold t))
+ (t
+ (:bold t)))
+ "Face used for high interest ancient articles.")
+
+(defface gnus-summary-low-ancient-face
+ '((((class color)
+ (background dark))
+ (:foreground "SkyBlue" :italic t))
+ (((class color)
+ (background light))
+ (:foreground "RoyalBlue" :italic t))
+ (t
+ (:italic t)))
+ "Face used for low interest ancient articles.")
+
+(defface gnus-summary-normal-ancient-face
+ '((((class color)
+ (background dark))
+ (:foreground "SkyBlue"))
+ (((class color)
+ (background light))
+ (:foreground "RoyalBlue"))
+ (t
+ ()))
+ "Face used for normal interest ancient articles.")
+
+(defface gnus-summary-high-unread-face
+ '((t
+ (:bold t)))
+ "Face used for high interest unread articles.")
+
+(defface gnus-summary-low-unread-face
+ '((t
+ (:italic t)))
+ "Face used for low interest unread articles.")
+
+(defface gnus-summary-normal-unread-face
+ '((t
+ ()))
+ "Face used for normal interest unread articles.")
+
+(defface gnus-summary-high-read-face
+ '((((class color)
+ (background dark))
+ (:foreground "PaleGreen"
+ :bold t))
+ (((class color)
+ (background light))
+ (:foreground "DarkGreen"
+ :bold t))
+ (t
+ (:bold t)))
+ "Face used for high interest read articles.")
+
+(defface gnus-summary-low-read-face
+ '((((class color)
+ (background dark))
+ (:foreground "PaleGreen"
+ :italic t))
+ (((class color)
+ (background light))
+ (:foreground "DarkGreen"
+ :italic t))
+ (t
+ (:italic t)))
+ "Face used for low interest read articles.")
+
+(defface gnus-summary-normal-read-face
+ '((((class color)
+ (background dark))
+ (:foreground "PaleGreen"))
+ (((class color)
+ (background light))
+ (:foreground "DarkGreen"))
+ (t
+ ()))
+ "Face used for normal interest read articles.")
+
+
+;;; Splash screen.
+
+(defvar gnus-group-buffer "*Group*")
+
+(eval-and-compile
+ (autoload 'gnus-play-jingle "gnus-audio"))
+
+(defface gnus-splash-face
+ '((((class color)
+ (background dark))
+ (:foreground "ForestGreen"))
+ (((class color)
+ (background light))
+ (:foreground "ForestGreen"))
+ (t
+ ()))
+ "Level 1 newsgroup face.")
+
+(defun gnus-splash ()
+ (save-excursion
+ (switch-to-buffer (get-buffer-create gnus-group-buffer))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (unless gnus-inhibit-startup-message
+ (gnus-group-startup-message)
+ (sit-for 0)
+ (when gnus-play-startup-jingle
+ (gnus-play-jingle))))))
+
+(defun gnus-indent-rigidly (start end arg)
+ "Indent rigidly using only spaces and no tabs."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (let ((tab-width 8))
+ (indent-rigidly start end arg)
+ ;; We translate tabs into spaces -- not everybody uses
+ ;; an 8-character tab.
+ (goto-char (point-min))
+ (while (search-forward "\t" nil t)
+ (replace-match " " t t))))))
+
+(defvar gnus-simple-splash nil)
+
+(defun gnus-group-startup-message (&optional x y)
+ "Insert startup message in current buffer."
+ ;; Insert the message.
+ (erase-buffer)
+ (insert
+ (format " %s
+ _ ___ _ _
+ _ ___ __ ___ __ _ ___
+ __ _ ___ __ ___
+ _ ___ _
+ _ _ __ _
+ ___ __ _
+ __ _
+ _ _ _
+ _ _ _
+ _ _ _
+ __ ___
+ _ _ _ _
+ _ _
+ _ _
+ _ _
+ _
+ __
+
+"
+ ""))
+ ;; And then hack it.
+ (gnus-indent-rigidly (point-min) (point-max)
+ (/ (max (- (window-width) (or x 46)) 0) 2))
+ (goto-char (point-min))
+ (forward-line 1)
+ (let* ((pheight (count-lines (point-min) (point-max)))
+ (wheight (window-height))
+ (rest (- wheight pheight)))
+ (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
+ ;; Fontify some.
+ (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
+ (goto-char (point-min))
+ (setq mode-line-buffer-identification (concat " " gnus-version))
+ (setq gnus-simple-splash t)
+ (set-buffer-modified-p t))
+
+(eval-when (load)
+ (let ((command (format "%s" this-command)))
+ (when (and (string-match "gnus" command)
+ (not (string-match "gnus-other-frame" command)))
+ (gnus-splash))))
+
+;;; Do the rest.
+
+(require 'custom)
+(require 'gnus-util)
+(require 'nnheader)
+
+(defcustom gnus-home-directory "~/"
+ "Directory variable that specifies the \"home\" directory.
+All other Gnus path variables are initialized from this variable."
+ :group 'gnus-files
+ :type 'directory)
+
+(defcustom gnus-directory (or (getenv "SAVEDIR")
+ (nnheader-concat gnus-home-directory "News/"))
+ "Directory variable from which all other Gnus file variables are derived."
+ :group 'gnus-files
+ :type 'directory)
+
+(defcustom gnus-default-directory nil
+ "*Default directory for all Gnus buffers."
+ :group 'gnus-files
+ :type '(choice (const :tag "current" nil)
+ directory))
+
+;; Site dependent variables. These variables should be defined in
+;; paths.el.
+
+(defvar gnus-default-nntp-server nil
+ "Specify a default NNTP server.
+This variable should be defined in paths.el, and should never be set
+by the user.
+If you want to change servers, you should use `gnus-select-method'.
+See the documentation to that variable.")
+
+;; Don't touch this variable.
+(defvar gnus-nntp-service "nntp"
+ "NNTP service name (\"nntp\" or 119).
+This is an obsolete variable, which is scarcely used. If you use an
+nntp server for your newsgroup and want to change the port number
+used to 899, you would say something along these lines:
+
+ (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
+
+(defcustom gnus-nntpserver-file "/etc/nntpserver"
+ "A file with only the name of the nntp server in it."
+ :group 'gnus-files
+ :group 'gnus-server
+ :type 'file)
+
+;; This function is used to check both the environment variable
+;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
+;; an nntp server name default.
+(defun gnus-getenv-nntpserver ()
+ (or (getenv "NNTPSERVER")
+ (and (file-readable-p gnus-nntpserver-file)
+ (save-excursion
+ (set-buffer (get-buffer-create " *gnus nntp*"))
+ (buffer-disable-undo (current-buffer))
+ (insert-file-contents gnus-nntpserver-file)
+ (let ((name (buffer-string)))
+ (prog1
+ (if (string-match "^[ \t\n]*$" name)
+ nil
+ name)
+ (kill-buffer (current-buffer))))))))
+
+(defcustom gnus-select-method
+ (condition-case nil
+ (nconc
+ (list 'nntp (or (condition-case nil
+ (gnus-getenv-nntpserver)
+ (error nil))
+ (when (and gnus-default-nntp-server
+ (not (string= gnus-default-nntp-server "")))
+ gnus-default-nntp-server)
+ "news"))
+ (if (or (null gnus-nntp-service)
+ (equal gnus-nntp-service "nntp"))
+ nil
+ (list gnus-nntp-service)))
+ (error nil))
+ "Default method for selecting a newsgroup.
+This variable should be a list, where the first element is how the
+news is to be fetched, the second is the address.
+
+For instance, if you want to get your news via NNTP from
+\"flab.flab.edu\", you could say:
+
+\(setq gnus-select-method '(nntp \"flab.flab.edu\"))
+
+If you want to use your local spool, say:
+
+\(setq gnus-select-method (list 'nnspool (system-name)))
+
+If you use this variable, you must set `gnus-nntp-server' to nil.
+
+There is a lot more to know about select methods and virtual servers -
+see the manual for details."
+ :group 'gnus-server
+ :type 'gnus-select-method)
+
+(defcustom gnus-message-archive-method
+ `(nnfolder
+ "archive"
+ (nnfolder-directory ,(nnheader-concat message-directory "archive"))
+ (nnfolder-active-file
+ ,(nnheader-concat message-directory "archive/active"))
+ (nnfolder-get-new-mail nil)
+ (nnfolder-inhibit-expiry t))
+ "Method used for archiving messages you've sent.
+This should be a mail method.
+
+It's probably not a very effective to change this variable once you've
+run Gnus once. After doing that, you must edit this server from the
+server buffer."
+ :group 'gnus-server
+ :group 'gnus-message
+ :type 'gnus-select-method)
+
+(defcustom gnus-message-archive-group nil
+ "*Name of the group in which to save the messages you've written.
+This can either be a string; a list of strings; or an alist
+of regexps/functions/forms to be evaluated to return a string (or a list
+of strings). The functions are called with the name of the current
+group (or nil) as a parameter.
+
+If you want to save your mail in one group and the news articles you
+write in another group, you could say something like:
+
+ \(setq gnus-message-archive-group
+ '((if (message-news-p)
+ \"misc-news\"
+ \"misc-mail\")))
+
+Normally the group names returned by this variable should be
+unprefixed -- which implicitly means \"store on the archive server\".
+However, you may wish to store the message on some other server. In
+that case, just return a fully prefixed name of the group --
+\"nnml+private:mail.misc\", for instance."
+ :group 'gnus-message
+ :type '(choice (const :tag "none" nil)
+ string))
+
+(defcustom gnus-secondary-servers nil
+ "List of NNTP servers that the user can choose between interactively.
+To make Gnus query you for a server, you have to give `gnus' a
+non-numeric prefix - `C-u M-x gnus', in short."
+ :group 'gnus-server
+ :type '(repeat string))
+
+(defcustom gnus-nntp-server nil
+ "*The name of the host running the NNTP server.
+This variable is semi-obsolete. Use the `gnus-select-method'
+variable instead."
+ :group 'gnus-server
+ :type '(choice (const :tag "disable" nil)
+ string))
+
+(defcustom gnus-secondary-select-methods nil
+ "A list of secondary methods that will be used for reading news.
+This is a list where each element is a complete select method (see
+`gnus-select-method').
+
+If, for instance, you want to read your mail with the nnml backend,
+you could set this variable:
+
+\(setq gnus-secondary-select-methods '((nnml \"\")))"
+:group 'gnus-server
+:type '(repeat gnus-select-method))
+
+(defvar gnus-backup-default-subscribed-newsgroups
+ '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
+ "Default default new newsgroups the first time Gnus is run.
+Should be set in paths.el, and shouldn't be touched by the user.")
+
+(defcustom gnus-local-domain nil
+ "Local domain name without a host name.
+The DOMAINNAME environment variable is used instead if it is defined.
+If the `system-name' function returns the full Internet name, there is
+no need to set this variable."
+ :group 'gnus-message
+ :type '(choice (const :tag "default" nil)
+ string))
+
+(defvar gnus-local-organization nil
+ "String with a description of what organization (if any) the user belongs to.
+Obsolete variable; use `message-user-organization' instead.")
+
+;; Customization variables
+
+(defcustom gnus-refer-article-method nil
+ "Preferred method for fetching an article by Message-ID.
+If you are reading news from the local spool (with nnspool), fetching
+articles by Message-ID is painfully slow. By setting this method to an
+nntp method, you might get acceptable results.
+
+The value of this variable must be a valid select method as discussed
+in the documentation of `gnus-select-method'."
+ :group 'gnus-server
+ :type '(choice (const :tag "default" nil)
+ gnus-select-method))
+
+(defcustom gnus-group-faq-directory
+ '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
+ "/ftp@sunsite.auc.dk:/pub/usenet/"
+ "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
+ "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
+ "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
+ "/ftp@rtfm.mit.edu:/pub/usenet/"
+ "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
+ "/ftp@ftp.sunet.se:/pub/usenet/"
+ "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
+ "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
+ "/ftp@ftp.hk.super.net:/mirror/faqs/")
+ "Directory where the group FAQs are stored.
+This will most commonly be on a remote machine, and the file will be
+fetched by ange-ftp.
+
+This variable can also be a list of directories. In that case, the
+first element in the list will be used by default. The others can
+be used when being prompted for a site.
+
+Note that Gnus uses an aol machine as the default directory. If this
+feels fundamentally unclean, just think of it as a way to finally get
+something of value back from them.
+
+If the default site is too slow, try one of these:
+
+ North America: mirrors.aol.com /pub/rtfm/usenet
+ ftp.seas.gwu.edu /pub/rtfm
+ rtfm.mit.edu /pub/usenet
+ Europe: ftp.uni-paderborn.de /pub/FAQ
+ src.doc.ic.ac.uk /usenet/news-FAQS
+ ftp.sunet.se /pub/usenet
+ sunsite.auc.dk /pub/usenet
+ Asia: nctuccca.edu.tw /USENET/FAQ
+ hwarang.postech.ac.kr /pub/usenet
+ ftp.hk.super.net /mirror/faqs"
+ :group 'gnus-group-various
+ :type '(choice directory
+ (repeat directory)))
+
+(defcustom gnus-use-cross-reference t
+ "*Non-nil means that cross referenced articles will be marked as read.
+If nil, ignore cross references. If t, mark articles as read in
+subscribed newsgroups. If neither t nor nil, mark as read in all
+newsgroups."
+ :group 'gnus-server
+ :type '(choice (const :tag "off" nil)
+ (const :tag "subscribed" t)
+ (sexp :format "all"
+ :value always)))
+
+(defcustom gnus-process-mark ?#
+ "*Process mark."
+ :group 'gnus-group-visual
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-asynchronous nil
+ "*If non-nil, Gnus will supply backends with data needed for async article fetching."
+ :group 'gnus-asynchronous
+ :type 'boolean)
+
+(defcustom gnus-large-newsgroup 200
+ "*The number of articles which indicates a large newsgroup.
+If the number of articles in a newsgroup is greater than this value,
+confirmation is required for selecting the newsgroup."
+ :group 'gnus-group-select
+ :type 'integer)
+
+(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
+ "*Non-nil means that the default name of a file to save articles in is the group name.
+If it's nil, the directory form of the group name is used instead.
+
+If this variable is a list, and the list contains the element
+`not-score', long file names will not be used for score files; if it
+contains the element `not-save', long file names will not be used for
+saving; and if it contains the element `not-kill', long file names
+will not be used for kill files.
+
+Note that the default for this variable varies according to what system
+type you're using. On `usg-unix-v' and `xenix' this variable defaults
+to nil while on all other systems it defaults to t."
+ :group 'gnus-start
+ :type 'boolean)
+
+(defcustom gnus-kill-files-directory gnus-directory
+ "*Name of the directory where kill files will be stored (default \"~/News\")."
+ :group 'gnus-score-files
+ :group 'gnus-score-kill
+ :type 'directory)
+
+(defcustom gnus-save-score nil
+ "*If non-nil, save group scoring info."
+ :group 'gnus-score-various
+ :group 'gnus-start
+ :type 'boolean)
+
+(defcustom gnus-use-undo t
+ "*If non-nil, allow undoing in Gnus group mode buffers."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-use-adaptive-scoring nil
+ "*If non-nil, use some adaptive scoring scheme.
+If a list, then the values `word' and `line' are meaningful. The
+former will perform adaption on individual words in the subject
+header while `line' will perform adaption on several headers."
+ :group 'gnus-meta
+ :group 'gnus-score-adapt
+ :type '(set (const word) (const line)))
+
+(defcustom gnus-use-cache 'passive
+ "*If nil, Gnus will ignore the article cache.
+If `passive', it will allow entering (and reading) articles
+explicitly entered into the cache. If anything else, use the
+cache to the full extent of the law."
+ :group 'gnus-meta
+ :group 'gnus-cache
+ :type '(choice (const :tag "off" nil)
+ (const :tag "passive" passive)
+ (const :tag "active" t)))
+
+(defcustom gnus-use-trees nil
+ "*If non-nil, display a thread tree buffer."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-use-grouplens nil
+ "*If non-nil, use GroupLens ratings."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-keep-backlog nil
+ "*If non-nil, Gnus will keep read articles for later re-retrieval.
+If it is a number N, then Gnus will only keep the last N articles
+read. If it is neither nil nor a number, Gnus will keep all read
+articles. This is not a good idea."
+ :group 'gnus-meta
+ :type '(choice (const :tag "off" nil)
+ integer
+ (sexp :format "all"
+ :value t)))
+
+(defcustom gnus-use-nocem nil
+ "*If non-nil, Gnus will read NoCeM cancel messages."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-suppress-duplicates nil
+ "*If non-nil, Gnus will mark duplicate copies of the same article as read."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-use-demon nil
+ "If non-nil, Gnus might use some demons."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-use-scoring t
+ "*If non-nil, enable scoring."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-use-picons nil
+ "*If non-nil, display picons."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-summary-prepare-exit-hook
+ '(gnus-summary-expire-articles)
+ "A hook called when preparing to exit from the summary buffer.
+It calls `gnus-summary-expire-articles' by default."
+ :group 'gnus-summary-exit
+ :type 'hook)
+
+(defcustom gnus-novice-user t
+ "*Non-nil means that you are a usenet novice.
+If non-nil, verbose messages may be displayed and confirmations may be
+required."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-expert-user nil
+ "*Non-nil means that you will never be asked for confirmation about anything.
+And that means *anything*."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-interactive-catchup t
+ "*If non-nil, require your confirmation when catching up a group."
+ :group 'gnus-group-select
+ :type 'boolean)
+
+(defcustom gnus-interactive-exit t
+ "*If non-nil, require your confirmation when exiting Gnus."
+ :group 'gnus-exit
+ :type 'boolean)
+
+(defcustom gnus-extract-address-components 'gnus-extract-address-components
+ "*Function for extracting address components from a From header.
+Two pre-defined function exist: `gnus-extract-address-components',
+which is the default, quite fast, and too simplistic solution, and
+`mail-extract-address-components', which works much better, but is
+slower."
+ :group 'gnus-summary-format
+ :type '(radio (function-item gnus-extract-address-components)
+ (function-item mail-extract-address-components)
+ (function :tag "Other")))
+
+(defcustom gnus-carpal nil
+ "*If non-nil, display clickable icons."
+ :group 'gnus-meta
+ :type 'boolean)
+
+(defcustom gnus-shell-command-separator ";"
+ "String used to separate to shell commands."
+ :group 'gnus-files
+ :type 'string)
+
+(defcustom gnus-valid-select-methods
+ '(("nntp" post address prompt-address physical-address)
+ ("nnspool" post address)
+ ("nnvirtual" post-mail virtual prompt-address)
+ ("nnmbox" mail respool address)
+ ("nnml" mail respool address)
+ ("nnmh" mail respool address)
+ ("nndir" post-mail prompt-address physical-address)
+ ("nneething" none address prompt-address physical-address)
+ ("nndoc" none address prompt-address)
+ ("nnbabyl" mail address respool)
+ ("nnkiboze" post virtual)
+ ("nnsoup" post-mail address)
+ ("nndraft" post-mail)
+ ("nnfolder" mail respool address)
+ ("nngateway" none address prompt-address physical-address)
+ ("nnweb" none)
+ ("nnagent" post-mail))
+ "An alist of valid select methods.
+The first element of each list lists should be a string with the name
+of the select method. The other elements may be the category of
+this method (i. e., `post', `mail', `none' or whatever) or other
+properties that this method has (like being respoolable).
+If you implement a new select method, all you should have to change is
+this variable. I think."
+ :group 'gnus-server
+ :type '(repeat (group (string :tag "Name")
+ (radio-button-choice (const :format "%v " post)
+ (const :format "%v " mail)
+ (const :format "%v " none)
+ (const post-mail))
+ (checklist :inline t
+ (const :format "%v " address)
+ (const :format "%v " prompt-address)
+ (const :format "%v " physical-address)
+ (const :format "%v " virtual)
+ (const respool)))))
+
+(define-widget 'gnus-select-method 'list
+ "Widget for entering a select method."
+ :args `((choice :tag "Method"
+ ,@(mapcar (lambda (entry)
+ (list 'const :format "%v\n"
+ (intern (car entry))))
+ gnus-valid-select-methods))
+ (string :tag "Address")
+ (editable-list :inline t
+ (list :format "%v"
+ variable
+ (sexp :tag "Value")))))
+
+(defcustom gnus-updated-mode-lines '(group article summary tree)
+ "List of buffers that should update their mode lines.
+The list may contain the symbols `group', `article', `tree' and
+`summary'. If the corresponding symbol is present, Gnus will keep
+that mode line updated with information that may be pertinent.
+If this variable is nil, screen refresh may be quicker."
+ :group 'gnus-various
+ :type '(set (const group)
+ (const article)
+ (const summary)
+ (const tree)))
+
+;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
+(defcustom gnus-mode-non-string-length nil
+ "*Max length of mode-line non-string contents.
+If this is nil, Gnus will take space as is needed, leaving the rest
+of the modeline intact. Note that the default of nil is unlikely
+to be desirable; see the manual for further details."
+ :group 'gnus-various
+ :type '(choice (const nil)
+ integer))
+
+(defcustom gnus-auto-expirable-newsgroups nil
+ "*Groups in which to automatically mark read articles as expirable.
+If non-nil, this should be a regexp that should match all groups in
+which to perform auto-expiry. This only makes sense for mail groups."
+ :group 'nnmail-expire
+ :type '(choice (const nil)
+ regexp))
+
+(defcustom gnus-total-expirable-newsgroups nil
+ "*Groups in which to perform expiry of all read articles.
+Use with extreme caution. All groups that match this regexp will be
+expiring - which means that all read articles will be deleted after
+\(say) one week. (This only goes for mail groups and the like, of
+course.)"
+ :group 'nnmail-expire
+ :type '(choice (const nil)
+ regexp))
+
+(defcustom gnus-group-uncollapsed-levels 1
+ "Number of group name elements to leave alone when making a short group name."
+ :group 'gnus-group-visual
+ :type 'integer)
+
+(defcustom gnus-group-use-permanent-levels nil
+ "*If non-nil, once you set a level, Gnus will use this level."
+ :group 'gnus-group-levels
+ :type 'boolean)
+
+;; Hooks.
+
+(defcustom gnus-load-hook nil
+ "A hook run while Gnus is loaded."
+ :group 'gnus-start
+ :type 'hook)
+
+(defcustom gnus-apply-kill-hook '(gnus-apply-kill-file)
+ "A hook called to apply kill files to a group.
+This hook is intended to apply a kill file to the selected newsgroup.
+The function `gnus-apply-kill-file' is called by default.
+
+Since a general kill file is too heavy to use only for a few
+newsgroups, I recommend you to use a lighter hook function. For
+example, if you'd like to apply a kill file to articles which contains
+a string `rmgroup' in subject in newsgroup `control', you can use the
+following hook:
+
+ (setq gnus-apply-kill-hook
+ (list
+ (lambda ()
+ (cond ((string-match \"control\" gnus-newsgroup-name)
+ (gnus-kill \"Subject\" \"rmgroup\")
+ (gnus-expunge \"X\"))))))"
+ :group 'gnus-score-kill
+ :options '(gnus-apply-kill-file)
+ :type 'hook)
+
+(defcustom gnus-group-change-level-function nil
+ "Function run when a group level is changed.
+It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
+ :group 'gnus-group-level
+ :type 'function)
+
+;;; Face thingies.
+
+(defcustom gnus-visual
+ '(summary-highlight group-highlight article-highlight
+ mouse-face
+ summary-menu group-menu article-menu
+ tree-highlight menu highlight
+ browse-menu server-menu
+ page-marker tree-menu binary-menu pick-menu
+ grouplens-menu)
+ "Enable visual features.
+If `visual' is disabled, there will be no menus and few faces. Most of
+the visual customization options below will be ignored. Gnus will use
+less space and be faster as a result.
+
+This variable can also be a list of visual elements to switch on. For
+instance, to switch off all visual things except menus, you can say:
+
+ (setq gnus-visual '(menu))
+
+Valid elements include `summary-highlight', `group-highlight',
+`article-highlight', `mouse-face', `summary-menu', `group-menu',
+`article-menu', `tree-highlight', `menu', `highlight', `browse-menu',
+`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu',
+and `grouplens-menu'."
+ :group 'gnus-meta
+ :group 'gnus-visual
+ :type '(set (const summary-highlight)
+ (const group-highlight)
+ (const article-highlight)
+ (const mouse-face)
+ (const summary-menu)
+ (const group-menu)
+ (const article-menu)
+ (const tree-highlight)
+ (const menu)
+ (const highlight)
+ (const browse-menu)
+ (const server-menu)
+ (const page-marker)
+ (const tree-menu)
+ (const binary-menu)
+ (const pick-menu)
+ (const grouplens-menu)))
+
+(defcustom gnus-mouse-face
+ (condition-case ()
+ (if (gnus-visual-p 'mouse-face 'highlight)
+ (if (boundp 'gnus-mouse-face)
+ (or gnus-mouse-face 'highlight)
+ 'highlight)
+ 'default)
+ (error 'highlight))
+ "Face used for group or summary buffer mouse highlighting.
+The line beneath the mouse pointer will be highlighted with this
+face."
+ :group 'gnus-visual
+ :type 'face)
+
+(defcustom gnus-article-display-hook
+ (if (and (string-match "XEmacs" emacs-version)
+ (featurep 'xface))
+ '(gnus-article-hide-headers-if-wanted
+ gnus-article-hide-boring-headers
+ gnus-article-treat-overstrike
+ gnus-article-maybe-highlight
+ gnus-article-display-x-face)
+ '(gnus-article-hide-headers-if-wanted
+ gnus-article-hide-boring-headers
+ gnus-article-treat-overstrike
+ gnus-article-maybe-highlight))
+ "Controls how the article buffer will look.
+
+If you leave the list empty, the article will appear exactly as it is
+stored on the disk. The list entries will hide or highlight various
+parts of the article, making it easier to find the information you
+want."
+ :group 'gnus-article-highlight
+ :group 'gnus-visual
+ :type 'hook
+ :options '(gnus-article-add-buttons
+ gnus-article-add-buttons-to-head
+ gnus-article-emphasize
+ gnus-article-fill-cited-article
+ gnus-article-remove-cr
+ gnus-article-de-quoted-unreadable
+ gnus-summary-stop-page-breaking
+ ;; gnus-summary-caesar-message
+ ;; gnus-summary-verbose-headers
+ gnus-summary-toggle-mime
+ gnus-article-hide
+ gnus-article-hide-headers
+ gnus-article-hide-boring-headers
+ gnus-article-hide-signature
+ gnus-article-hide-citation
+ gnus-article-hide-pgp
+ gnus-article-hide-pem
+ gnus-article-highlight
+ gnus-article-highlight-headers
+ gnus-article-highlight-citation
+ gnus-article-highlight-signature
+ gnus-article-date-ut
+ gnus-article-date-local
+ gnus-article-date-lapsed
+ gnus-article-date-original
+ gnus-article-remove-trailing-blank-lines
+ gnus-article-strip-leading-blank-lines
+ gnus-article-strip-multiple-blank-lines
+ gnus-article-strip-blank-lines
+ gnus-article-treat-overstrike
+ gnus-article-display-x-face
+ gnus-smiley-display))
+
+(defcustom gnus-article-save-directory gnus-directory
+ "*Name of the directory articles will be saved in (default \"~/News\")."
+ :group 'gnus-article-saving
+ :type 'directory)
+
+\f
+;;; Internal variables
+
+(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
+(defvar gnus-original-article-buffer " *Original Article*")
+(defvar gnus-newsgroup-name nil)
+
+(defvar gnus-agent nil
+ "Whether we want to use the Gnus agent or not.")
+
+(defvar gnus-command-method nil
+ "Dynamically bound variable that says what the current backend is.")
+
+(defvar gnus-current-select-method nil
+ "The current method for selecting a newsgroup.")
+
+(defvar gnus-tree-buffer "*Tree*"
+ "Buffer where Gnus thread trees are displayed.")
+
+;; Dummy variable.
+(defvar gnus-use-generic-from nil)
+
+;; Variable holding the user answers to all method prompts.
+(defvar gnus-method-history nil)
+(defvar gnus-group-history nil)
+
+;; Variable holding the user answers to all mail method prompts.
+(defvar gnus-mail-method-history nil)
+
+;; Variable holding the user answers to all group prompts.
+(defvar gnus-group-history nil)
+
+(defvar gnus-server-alist nil
+ "List of available servers.")
+
+(defvar gnus-predefined-server-alist
+ `(("cache"
+ (nnspool "cache"
+ (nnspool-spool-directory "~/News/cache/")
+ (nnspool-nov-directory "~/News/cache/")
+ (nnspool-active-file "~/News/cache/active"))))
+ "List of predefined (convenience) servers.")
+
+(defvar gnus-topic-indentation "") ;; Obsolete variable.
+
+(defconst gnus-article-mark-lists
+ '((marked . tick) (replied . reply)
+ (expirable . expire) (killed . killed)
+ (bookmarks . bookmark) (dormant . dormant)
+ (scored . score) (saved . save)
+ (cached . cache) (downloadable . download)
+ (unsendable . unsend)))
+
+(defvar gnus-headers-retrieved-by nil)
+(defvar gnus-article-reply nil)
+(defvar gnus-override-method nil)
+(defvar gnus-article-check-size nil)
+(defvar gnus-opened-servers nil)
+
+(defvar gnus-current-kill-article nil)
+
+(defvar gnus-have-read-active-file nil)
+
+(defconst gnus-maintainer
+ "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)"
+ "The mail address of the Gnus maintainers.")
+
+(defvar gnus-info-nodes
+ '((gnus-group-mode "(gnus)The Group Buffer")
+ (gnus-summary-mode "(gnus)The Summary Buffer")
+ (gnus-article-mode "(gnus)The Article Buffer")
+ (mime/viewer-mode "(gnus)The Article Buffer")
+ (gnus-server-mode "(gnus)The Server Buffer")
+ (gnus-browse-mode "(gnus)Browse Foreign Server")
+ (gnus-tree-mode "(gnus)Tree Display"))
+ "Alist of major modes and related Info nodes.")
+
+(defvar gnus-group-buffer "*Group*")
+(defvar gnus-summary-buffer "*Summary*")
+(defvar gnus-article-buffer "*Article*")
+(defvar gnus-server-buffer "*Server*")
+
+(defvar gnus-buffer-list nil
+ "Gnus buffers that should be killed on exit.")
+
+(defvar gnus-slave nil
+ "Whether this Gnus is a slave or not.")
+
+(defvar gnus-batch-mode nil
+ "Whether this Gnus is running in batch mode or not.")
+
+(defvar gnus-variable-list
+ '(gnus-newsrc-options gnus-newsrc-options-n
+ gnus-newsrc-last-checked-date
+ gnus-newsrc-alist gnus-server-alist
+ gnus-killed-list gnus-zombie-list
+ gnus-topic-topology gnus-topic-alist
+ gnus-format-specs)
+ "Gnus variables saved in the quick startup file.")
+
+(defvar gnus-newsrc-alist nil
+ "Assoc list of read articles.
+gnus-newsrc-hashtb should be kept so that both hold the same information.")
+
+(defvar gnus-newsrc-hashtb nil
+ "Hashtable of gnus-newsrc-alist.")
+
+(defvar gnus-killed-list nil
+ "List of killed newsgroups.")
+
+(defvar gnus-killed-hashtb nil
+ "Hash table equivalent of gnus-killed-list.")
+
+(defvar gnus-zombie-list nil
+ "List of almost dead newsgroups.")
+
+(defvar gnus-description-hashtb nil
+ "Descriptions of newsgroups.")
+
+(defvar gnus-list-of-killed-groups nil
+ "List of newsgroups that have recently been killed by the user.")
+
+(defvar gnus-active-hashtb nil
+ "Hashtable of active articles.")
+
+(defvar gnus-moderated-hashtb nil
+ "Hashtable of moderated newsgroups.")
+
+;; Save window configuration.
+(defvar gnus-prev-winconf nil)
+
+(defvar gnus-reffed-article-number nil)
+
+;;; Let the byte-compiler know that we know about this variable.
+(defvar rmail-default-rmail-file)
+
+(defvar gnus-dead-summary nil)
+
+;;; End of variables.
+
+;; Define some autoload functions Gnus might use.
+(eval-and-compile
+
+ ;; This little mapcar goes through the list below and marks the
+ ;; symbols in question as autoloaded functions.
+ (mapcar
+ (lambda (package)
+ (let ((interactive (nth 1 (memq ':interactive package))))
+ (mapcar
+ (lambda (function)
+ (let (keymap)
+ (when (consp function)
+ (setq keymap (car (memq 'keymap function)))
+ (setq function (car function)))
+ (autoload function (car package) nil interactive keymap)))
+ (if (eq (nth 1 package) ':interactive)
+ (cdddr package)
+ (cdr package)))))
+ '(("metamail" metamail-buffer)
+ ("info" Info-goto-node)
+ ("hexl" hexl-hex-string-to-integer)
+ ("pp" pp pp-to-string pp-eval-expression)
+ ("ps-print" ps-print-preprint)
+ ("mail-extr" mail-extract-address-components)
+ ("message" :interactive t
+ message-send-and-exit message-yank-original)
+ ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time)
+ ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
+ ("timezone" timezone-make-date-arpa-standard timezone-fix-time
+ timezone-make-sortable-date timezone-make-time-string)
+ ("rmailout" rmail-output)
+ ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
+ rmail-show-message)
+ ("gnus-audio" :interactive t gnus-audio-play)
+ ("gnus-xmas" gnus-xmas-splash)
+ ("gnus-soup" :interactive t
+ gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
+ gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
+ ("nnsoup" nnsoup-pack-replies)
+ ("score-mode" :interactive t gnus-score-mode)
+ ("gnus-mh" gnus-summary-save-article-folder
+ gnus-Folder-save-name gnus-folder-save-name)
+ ("gnus-mh" :interactive t gnus-summary-save-in-folder)
+ ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
+ gnus-demon-add-rescan gnus-demon-add-scan-timestamps
+ gnus-demon-add-disconnection gnus-demon-add-handler
+ gnus-demon-remove-handler)
+ ("gnus-demon" :interactive t
+ gnus-demon-init gnus-demon-cancel)
+ ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
+ gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
+ ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
+ gnus-nocem-unwanted-article-p)
+ ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
+ gnus-server-server-name)
+ ("gnus-srvr" gnus-browse-foreign-server)
+ ("gnus-cite" :interactive t
+ gnus-article-highlight-citation gnus-article-hide-citation-maybe
+ gnus-article-hide-citation gnus-article-fill-cited-article
+ gnus-article-hide-citation-in-followups)
+ ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
+ gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
+ gnus-execute gnus-expunge)
+ ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
+ gnus-cache-possibly-remove-articles gnus-cache-request-article
+ gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
+ gnus-cache-enter-remove-article gnus-cached-article-p
+ gnus-cache-open gnus-cache-close gnus-cache-update-article)
+ ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
+ gnus-cache-remove-article gnus-summary-insert-cached-articles)
+ ("gnus-score" :interactive t
+ gnus-summary-increase-score gnus-summary-set-score
+ gnus-summary-raise-thread gnus-summary-raise-same-subject
+ gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
+ gnus-summary-lower-thread gnus-summary-lower-same-subject
+ gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
+ gnus-summary-current-score gnus-score-default
+ gnus-score-flush-cache gnus-score-close
+ gnus-possibly-score-headers gnus-score-followup-article
+ gnus-score-followup-thread)
+ ("gnus-score"
+ (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
+ gnus-current-score-file-nondirectory gnus-score-adaptive
+ gnus-score-find-trace gnus-score-file-name)
+ ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
+ ("gnus-topic" :interactive t gnus-topic-mode)
+ ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters)
+ ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
+ ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
+ ("gnus-uu" :interactive t
+ gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
+ gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
+ gnus-uu-mark-by-regexp gnus-uu-mark-all
+ gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
+ gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
+ gnus-uu-decode-unshar-and-save gnus-uu-decode-save
+ gnus-uu-decode-binhex gnus-uu-decode-uu-view
+ gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
+ gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
+ gnus-uu-decode-binhex-view)
+ ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh)
+ ("gnus-msg" (gnus-summary-send-map keymap)
+ gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
+ ("gnus-msg" :interactive t
+ gnus-group-post-news gnus-group-mail gnus-summary-post-news
+ gnus-summary-followup gnus-summary-followup-with-original
+ gnus-summary-cancel-article gnus-summary-supersede-article
+ gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
+ gnus-summary-mail-forward gnus-summary-mail-other-window
+ gnus-summary-resend-message gnus-summary-resend-bounced-mail
+ gnus-bug)
+ ("gnus-picon" :interactive t gnus-article-display-picons
+ gnus-group-display-picons gnus-picons-article-display-x-face
+ gnus-picons-display-x-face)
+ ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
+ gnus-grouplens-mode)
+ ("smiley" :interactive t gnus-smiley-display)
+ ("gnus-win" gnus-configure-windows gnus-add-configuration)
+ ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
+ gnus-list-of-unread-articles gnus-list-of-read-articles
+ gnus-offer-save-summaries gnus-make-thread-indent-array
+ gnus-summary-exit gnus-update-read-articles)
+ ("gnus-group" gnus-group-insert-group-line gnus-group-quit
+ gnus-group-list-groups gnus-group-first-unread-group
+ gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
+ gnus-group-setup-buffer gnus-group-get-new-news
+ gnus-group-make-help-group gnus-group-update-group)
+ ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
+ gnus-backlog-remove-article)
+ ("gnus-art" gnus-article-read-summary-keys gnus-article-save
+ gnus-article-prepare gnus-article-set-window-start
+ gnus-article-next-page gnus-article-prev-page
+ gnus-request-article-this-buffer gnus-article-mode
+ gnus-article-setup-buffer gnus-narrow-to-page
+ gnus-article-delete-invisible-text gnus-hack-decode-rfc1522)
+ ("gnus-art" :interactive t
+ gnus-article-hide-headers gnus-article-hide-boring-headers
+ gnus-article-treat-overstrike gnus-article-word-wrap
+ gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
+ gnus-article-display-x-face gnus-article-de-quoted-unreadable
+ gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp
+ gnus-article-hide-pem gnus-article-hide-signature
+ gnus-article-strip-leading-blank-lines gnus-article-date-local
+ gnus-article-date-original gnus-article-date-lapsed
+ gnus-article-show-all-headers
+ gnus-article-edit-mode gnus-article-edit-article
+ gnus-article-edit-done gnus-decode-rfc1522 article-decode-rfc1522)
+ ("gnus-int" gnus-request-type)
+ ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
+ gnus-dribble-enter)
+ ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
+ gnus-dup-enter-articles)
+ ("gnus-range" gnus-copy-sequence)
+ ("gnus-eform" gnus-edit-form)
+ ("gnus-move" :interactive t
+ gnus-group-move-group-to-server gnus-change-server)
+ ("gnus-logic" gnus-score-advanced)
+ ("gnus-undo" gnus-undo-mode gnus-undo-register)
+ ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
+ gnus-async-prefetch-article gnus-async-prefetch-remove-group
+ gnus-async-halt-prefetch)
+ ("gnus-agent" gnus-open-agent gnus-agent-get-function
+ gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p
+ gnus-agent-get-undownloaded-list)
+ ("gnus-agent" :interactive t
+ gnus-unplugged gnus-agentize)
+ ("gnus-vm" :interactive t gnus-summary-save-in-vm
+ gnus-summary-save-article-vm)
+ ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts))))
+
+;;; gnus-sum.el thingies
+
+
+(defcustom gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ "*The format specification of the lines in the summary buffer.
+
+It works along the same lines as a normal formatting string,
+with some simple extensions.
+
+%N Article number, left padded with spaces (string)
+%S Subject (string)
+%s Subject if it is at the root of a thread, and \"\" otherwise (string)
+%n Name of the poster (string)
+%a Extracted name of the poster (string)
+%A Extracted address of the poster (string)
+%F Contents of the From: header (string)
+%x Contents of the Xref: header (string)
+%D Date of the article (string)
+%d Date of the article (string) in DD-MMM format
+%M Message-id of the article (string)
+%r References of the article (string)
+%c Number of characters in the article (integer)
+%L Number of lines in the article (integer)
+%I Indentation based on thread level (a string of spaces)
+%T A string with two possible values: 80 spaces if the article
+ is on thread level two or larger and 0 spaces on level one
+%R \"A\" if this article has been replied to, \" \" otherwise (character)
+%U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
+%[ Opening bracket (character, \"[\" or \"<\")
+%] Closing bracket (character, \"]\" or \">\")
+%> Spaces of length thread-level (string)
+%< Spaces of length (- 20 thread-level) (string)
+%i Article score (number)
+%z Article zcore (character)
+%t Number of articles under the current thread (number).
+%e Whether the thread is empty or not (character).
+%l GroupLens score (string).
+%V Total thread score (number).
+%P The line number (number).
+%O Download mark (character).
+%u User defined specifier. The next character in the format string should
+ be a letter. Gnus will call the function gnus-user-format-function-X,
+ where X is the letter following %u. The function will be passed the
+ current header as argument. The function should return a string, which
+ will be inserted into the summary just like information from any other
+ summary specifier.
+
+Text between %( and %) will be highlighted with `gnus-mouse-face'
+when the mouse point is placed inside the area. There can only be one
+such area.
+
+The %U (status), %R (replied) and %z (zcore) specs have to be handled
+with care. For reasons of efficiency, Gnus will compute what column
+these characters will end up in, and \"hard-code\" that. This means that
+it is illegal to have these specs after a variable-length spec. Well,
+you might not be arrested, but your summary buffer will look strange,
+which is bad enough.
+
+The smart choice is to have these specs as for to the left as
+possible.
+
+This restriction may disappear in later versions of Gnus."
+ :type 'string
+ :group 'gnus-summary-format)
+
+;;;
+;;; Skeleton keymaps
+;;;
+
+(defun gnus-suppress-keymap (keymap)
+ (suppress-keymap keymap)
+ (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2
+ (while keys
+ (define-key keymap (pop keys) 'undefined))))
+
+(defvar gnus-article-mode-map
+ (let ((keymap (make-keymap)))
+ (gnus-suppress-keymap keymap)
+ keymap))
+(defvar gnus-summary-mode-map
+ (let ((keymap (make-keymap)))
+ (gnus-suppress-keymap keymap)
+ keymap))
+(defvar gnus-group-mode-map
+ (let ((keymap (make-keymap)))
+ (gnus-suppress-keymap keymap)
+ keymap))
+
+\f
+
+;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
+;; If you want the cursor to go somewhere else, set these two
+;; functions in some startup hook to whatever you want.
+(defalias 'gnus-summary-position-point 'gnus-goto-colon)
+(defalias 'gnus-group-position-point 'gnus-goto-colon)
+
+;;; Various macros and substs.
+
+(defun gnus-header-from (header)
+ (mail-header-from header))
+
+(defmacro gnus-gethash (string hashtable)
+ "Get hash value of STRING in HASHTABLE."
+ `(symbol-value (intern-soft ,string ,hashtable)))
+
+(defmacro gnus-sethash (string value hashtable)
+ "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
+ `(set (intern ,string ,hashtable) ,value))
+(put 'gnus-sethash 'edebug-form-spec '(form form form))
+
+(defmacro gnus-group-unread (group)
+ "Get the currently computed number of unread articles in GROUP."
+ `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
+
+(defmacro gnus-group-entry (group)
+ "Get the newsrc entry for GROUP."
+ `(gnus-gethash ,group gnus-newsrc-hashtb))
+
+(defmacro gnus-active (group)
+ "Get active info on GROUP."
+ `(gnus-gethash ,group gnus-active-hashtb))
+
+(defmacro gnus-set-active (group active)
+ "Set GROUP's active info."
+ `(gnus-sethash ,group ,active gnus-active-hashtb))
+
+(defun gnus-alive-p ()
+ "Say whether Gnus is running or not."
+ (and gnus-group-buffer
+ (get-buffer gnus-group-buffer)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (eq major-mode 'gnus-group-mode))))
+
+;; Info access macros.
+
+(defmacro gnus-info-group (info)
+ `(nth 0 ,info))
+(defmacro gnus-info-rank (info)
+ `(nth 1 ,info))
+(defmacro gnus-info-read (info)
+ `(nth 2 ,info))
+(defmacro gnus-info-marks (info)
+ `(nth 3 ,info))
+(defmacro gnus-info-method (info)
+ `(nth 4 ,info))
+(defmacro gnus-info-params (info)
+ `(nth 5 ,info))
+
+(defmacro gnus-info-level (info)
+ `(let ((rank (gnus-info-rank ,info)))
+ (if (consp rank)
+ (car rank)
+ rank)))
+(defmacro gnus-info-score (info)
+ `(let ((rank (gnus-info-rank ,info)))
+ (or (and (consp rank) (cdr rank)) 0)))
+
+(defmacro gnus-info-set-group (info group)
+ `(setcar ,info ,group))
+(defmacro gnus-info-set-rank (info rank)
+ `(setcar (nthcdr 1 ,info) ,rank))
+(defmacro gnus-info-set-read (info read)
+ `(setcar (nthcdr 2 ,info) ,read))
+(defmacro gnus-info-set-marks (info marks &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,marks 3)
+ `(setcar (nthcdr 3 ,info) ,marks)))
+(defmacro gnus-info-set-method (info method &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,method 4)
+ `(setcar (nthcdr 4 ,info) ,method)))
+(defmacro gnus-info-set-params (info params &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,params 5)
+ `(setcar (nthcdr 5 ,info) ,params)))
+
+(defun gnus-info-set-entry (info entry number)
+ ;; Extend the info until we have enough elements.
+ (while (<= (length info) number)
+ (nconc info (list nil)))
+ ;; Set the entry.
+ (setcar (nthcdr number info) entry))
+
+(defmacro gnus-info-set-level (info level)
+ `(let ((rank (cdr ,info)))
+ (if (consp (car rank))
+ (setcar (car rank) ,level)
+ (setcar rank ,level))))
+(defmacro gnus-info-set-score (info score)
+ `(let ((rank (cdr ,info)))
+ (if (consp (car rank))
+ (setcdr (car rank) ,score)
+ (setcar rank (cons (car rank) ,score)))))
+
+(defmacro gnus-get-info (group)
+ `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
+
+;; Byte-compiler warning.
+(defvar gnus-visual)
+;; Find out whether the gnus-visual TYPE is wanted.
+(defun gnus-visual-p (&optional type class)
+ (and gnus-visual ; Has to be non-nil, at least.
+ (if (not type) ; We don't care about type.
+ gnus-visual
+ (if (listp gnus-visual) ; It's a list, so we check it.
+ (or (memq type gnus-visual)
+ (memq class gnus-visual))
+ t))))
+
+;;; Load the compatability functions.
+
+(require 'gnus-ems)
+
+\f
+;;;
+;;; Shutdown
+;;;
+
+(defvar gnus-shutdown-alist nil)
+
+(defun gnus-add-shutdown (function &rest symbols)
+ "Run FUNCTION whenever one of SYMBOLS is shut down."
+ (push (cons function symbols) gnus-shutdown-alist))
+
+(defun gnus-shutdown (symbol)
+ "Shut down everything that waits for SYMBOL."
+ (let ((alist gnus-shutdown-alist)
+ entry)
+ (while (setq entry (pop alist))
+ (when (memq symbol (cdr entry))
+ (funcall (car entry))))))
+
+\f
+;;;
+;;; Gnus Utility Functions
+;;;
+
+(defmacro gnus-string-or (&rest strings)
+ "Return the first element of STRINGS that is a non-blank string.
+STRINGS will be evaluated in normal `or' order."
+ `(gnus-string-or-1 ',strings))
+
+(defun gnus-string-or-1 (strings)
+ (let (string)
+ (while strings
+ (setq string (eval (pop strings)))
+ (if (string-match "^[ \t]*$" string)
+ (setq string nil)
+ (setq strings nil)))
+ string))
+
+;; Add the current buffer to the list of buffers to be killed on exit.
+(defun gnus-add-current-to-buffer-list ()
+ (or (memq (current-buffer) gnus-buffer-list)
+ (push (current-buffer) gnus-buffer-list)))
+
+(defun gnus-version (&optional arg)
+ "Version number of this version of Gnus.
+If ARG, insert string at point."
+ (interactive "P")
+ (let ((methods gnus-valid-select-methods)
+ (mess gnus-version)
+ meth)
+ ;; Go through all the legal select methods and add their version
+ ;; numbers to the total version string. Only the backends that are
+ ;; currently in use will have their message numbers taken into
+ ;; consideration.
+ (while methods
+ (setq meth (intern (concat (caar methods) "-version")))
+ (and (boundp meth)
+ (stringp (symbol-value meth))
+ (setq mess (concat mess "; " (symbol-value meth))))
+ (setq methods (cdr methods)))
+ (if arg
+ (insert (message mess))
+ (message mess))))
+
+(defun gnus-continuum-version (version)
+ "Return VERSION as a floating point number."
+ (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
+ (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
+ (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
+ (number (match-string 2 version))
+ major minor least)
+ (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
+ (setq major (string-to-number (match-string 1 number)))
+ (setq minor (string-to-number (match-string 2 number)))
+ (setq least (if (match-beginning 3)
+ (string-to-number (match-string 3 number))
+ 0))
+ (string-to-number
+ (if (zerop major)
+ (format "%s00%02d%02d"
+ (cond
+ ((member alpha '("(ding)" "d")) "4.99")
+ ((member alpha '("September" "s")) "5.01")
+ ((member alpha '("Red" "r")) "5.03"))
+ minor least)
+ (format "%d.%02d%02d" major minor least))))))
+
+(defun gnus-info-find-node ()
+ "Find Info documentation of Gnus."
+ (interactive)
+ ;; Enlarge info window if needed.
+ (let (gnus-info-buffer)
+ (Info-goto-node (cadr (assq major-mode gnus-info-nodes)))
+ (setq gnus-info-buffer (current-buffer))
+ (gnus-configure-windows 'info)))
+
+;;;
+;;; gnus-interactive
+;;;
+
+(defvar gnus-current-prefix-symbol nil
+ "Current prefix symbol.")
+
+(defvar gnus-current-prefix-symbols nil
+ "List of current prefix symbols.")
+
+(defun gnus-interactive (string &optional params)
+ "Return a list that can be fed to `interactive'.
+See `interactive' for full documentation.
+
+Adds the following specs:
+
+y -- The current symbolic prefix.
+Y -- A list of the current symbolic prefix(es).
+A -- Article number.
+H -- Article header.
+g -- Group name."
+ (let ((i 0)
+ out c prompt)
+ (while (< i (length string))
+ (string-match ".\\([^\n]*\\)\n?" string i)
+ (setq c (aref string i))
+ (when (match-end 1)
+ (setq prompt (match-string 1 string)))
+ (setq i (match-end 0))
+ ;; We basically emulate just about everything that
+ ;; `interactive' does, but adds the "g" and "G" specs.
+ (push
+ (cond
+ ((= c ?a)
+ (completing-read prompt obarray 'fboundp t))
+ ((= c ?b)
+ (read-buffer prompt (current-buffer) t))
+ ((= c ?B)
+ (read-buffer prompt (other-buffer (current-buffer))))
+ ((= c ?c)
+ (read-char))
+ ((= c ?C)
+ (completing-read prompt obarray 'commandp t))
+ ((= c ?d)
+ (point))
+ ((= c ?D)
+ (read-file-name prompt nil default-directory 'lambda))
+ ((= c ?f)
+ (read-file-name prompt nil nil 'lambda))
+ ((= c ?F)
+ (read-file-name prompt))
+ ((= c ?k)
+ (read-key-sequence prompt))
+ ((= c ?K)
+ (error "Not implemented spec"))
+ ((= c ?e)
+ (error "Not implemented spec"))
+ ((= c ?m)
+ (mark))
+ ((= c ?N)
+ (error "Not implemented spec"))
+ ((= c ?n)
+ (string-to-number (read-from-minibuffer prompt)))
+ ((= c ?p)
+ (prefix-numeric-value current-prefix-arg))
+ ((= c ?P)
+ current-prefix-arg)
+ ((= c ?r)
+ 'gnus-prefix-nil)
+ ((= c ?s)
+ (read-string prompt))
+ ((= c ?S)
+ (intern (read-string prompt)))
+ ((= c ?v)
+ (read-variable prompt))
+ ((= c ?x)
+ (read-minibuffer prompt))
+ ((= c ?x)
+ (eval-minibuffer prompt))
+ ;; And here the new specs come.
+ ((= c ?y)
+ gnus-current-prefix-symbol)
+ ((= c ?Y)
+ gnus-current-prefix-symbols)
+ ((= c ?g)
+ (gnus-group-group-name))
+ ((= c ?A)
+ (gnus-summary-article-number))
+ ((= c ?H)
+ (gnus-summary-article-header))
+ (t
+ (error "Not implemented spec")))
+ out)
+ (cond
+ ((= c ?r)
+ (push (if (< (point) (mark) (point) (mark))) out)
+ (push (if (> (point) (mark) (point) (mark))) out))))
+ (setq out (delq 'gnus-prefix-nil out))
+ (nreverse out)))
+
+(defun gnus-symbolic-argument (&optional arg)
+ "Read a symbolic argument and a command, and then execute command."
+ (interactive "P")
+ (let* ((in-command (this-command-keys))
+ (command in-command)
+ gnus-current-prefix-symbols
+ gnus-current-prefix-symbol
+ syms)
+ (while (equal in-command command)
+ (message "%s-" (key-description (this-command-keys)))
+ (push (intern (char-to-string (read-char))) syms)
+ (setq command (read-key-sequence nil t)))
+ (setq gnus-current-prefix-symbols (nreverse syms)
+ gnus-current-prefix-symbol (car gnus-current-prefix-symbols))
+ (call-interactively (key-binding command t))))
+
+;;; More various functions.
+
+(defsubst gnus-check-backend-function (func group)
+ "Check whether GROUP supports function FUNC.
+GROUP can either be a string (a group name) or a select method."
+ (ignore-errors
+ (let ((method (if (stringp group)
+ (car (gnus-find-method-for-group group))
+ group)))
+ (unless (featurep method)
+ (require method))
+ (fboundp (intern (format "%s-%s" method func))))))
+
+(defun gnus-group-read-only-p (&optional group)
+ "Check whether GROUP supports editing or not.
+If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note
+that that variable is buffer-local to the summary buffers."
+ (let ((group (or group gnus-newsgroup-name)))
+ (not (gnus-check-backend-function 'request-replace-article group))))
+
+(defun gnus-group-total-expirable-p (group)
+ "Check whether GROUP is total-expirable or not."
+ (let ((params (gnus-group-find-parameter group))
+ val)
+ (cond
+ ((memq 'total-expire params)
+ t)
+ ((setq val (assq 'total-expire params)) ; (auto-expire . t)
+ (cdr val))
+ (gnus-total-expirable-newsgroups ; Check var.
+ (string-match gnus-total-expirable-newsgroups group)))))
+
+(defun gnus-group-auto-expirable-p (group)
+ "Check whether GROUP is auto-expirable or not."
+ (let ((params (gnus-group-find-parameter group))
+ val)
+ (cond
+ ((memq 'auto-expire params)
+ t)
+ ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
+ (cdr val))
+ (gnus-auto-expirable-newsgroups ; Check var.
+ (string-match gnus-auto-expirable-newsgroups group)))))
+
+(defun gnus-virtual-group-p (group)
+ "Say whether GROUP is virtual or not."
+ (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
+ gnus-valid-select-methods)))
+
+(defun gnus-news-group-p (group &optional article)
+ "Return non-nil if GROUP (and ARTICLE) come from a news server."
+ (or (gnus-member-of-valid 'post group) ; Ordinary news group.
+ (and (gnus-member-of-valid 'post-mail group) ; Combined group.
+ (eq (gnus-request-type group article) 'news))))
+
+;; Returns a list of writable groups.
+(defun gnus-writable-groups ()
+ (let ((alist gnus-newsrc-alist)
+ groups group)
+ (while (setq group (car (pop alist)))
+ (unless (gnus-group-read-only-p group)
+ (push group groups)))
+ (nreverse groups)))
+
+;; Check whether to use long file names.
+(defun gnus-use-long-file-name (symbol)
+ ;; The variable has to be set...
+ (and gnus-use-long-file-name
+ ;; If it isn't a list, then we return t.
+ (or (not (listp gnus-use-long-file-name))
+ ;; If it is a list, and the list contains `symbol', we
+ ;; return nil.
+ (not (memq symbol gnus-use-long-file-name)))))
+
+;; Generate a unique new group name.
+(defun gnus-generate-new-group-name (leaf)
+ (let ((name leaf)
+ (num 0))
+ (while (gnus-gethash name gnus-newsrc-hashtb)
+ (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
+ name))
+
+(defun gnus-ephemeral-group-p (group)
+ "Say whether GROUP is ephemeral or not."
+ (gnus-group-get-parameter group 'quit-config))
+
+(defun gnus-group-quit-config (group)
+ "Return the quit-config of GROUP."
+ (gnus-group-get-parameter group 'quit-config))
+
+(defun gnus-kill-ephemeral-group (group)
+ "Remove ephemeral GROUP from relevant structures."
+ (gnus-sethash group nil gnus-newsrc-hashtb))
+
+(defun gnus-simplify-mode-line ()
+ "Make mode lines a bit simpler."
+ (setq mode-line-modified (cdr gnus-mode-line-modified))
+ (when (listp mode-line-format)
+ (make-local-variable 'mode-line-format)
+ (setq mode-line-format (copy-sequence mode-line-format))
+ (when (equal (nth 3 mode-line-format) " ")
+ (setcar (nthcdr 3 mode-line-format) " "))))
+
+;;; Servers and groups.
+
+(defsubst gnus-server-add-address (method)
+ (let ((method-name (symbol-name (car method))))
+ (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
+ (not (assq (intern (concat method-name "-address")) method))
+ (memq 'physical-address (assq (car method)
+ gnus-valid-select-methods)))
+ (append method (list (list (intern (concat method-name "-address"))
+ (nth 1 method))))
+ method)))
+
+(defsubst gnus-server-get-method (group method)
+ ;; Input either a server name, and extended server name, or a
+ ;; select method, and return a select method.
+ (cond ((stringp method)
+ (gnus-server-to-method method))
+ ((equal method gnus-select-method)
+ gnus-select-method)
+ ((and (stringp (car method)) group)
+ (gnus-server-extend-method group method))
+ ((and method (not group)
+ (equal (cadr method) ""))
+ method)
+ (t
+ (gnus-server-add-address method))))
+
+(defun gnus-server-to-method (server)
+ "Map virtual server names to select methods."
+ (or
+ ;; Is this a method, perhaps?
+ (and server (listp server) server)
+ ;; Perhaps this is the native server?
+ (and (equal server "native") gnus-select-method)
+ ;; It should be in the server alist.
+ (cdr (assoc server gnus-server-alist))
+ ;; It could be in the predefined server alist.
+ (cdr (assoc server gnus-predefined-server-alist))
+ ;; If not, we look through all the opened server
+ ;; to see whether we can find it there.
+ (let ((opened gnus-opened-servers))
+ (while (and opened
+ (not (equal server (format "%s:%s" (caaar opened)
+ (cadaar opened)))))
+ (pop opened))
+ (caar opened))))
+
+(defmacro gnus-method-equal (ss1 ss2)
+ "Say whether two servers are equal."
+ `(let ((s1 ,ss1)
+ (s2 ,ss2))
+ (or (equal s1 s2)
+ (and (= (length s1) (length s2))
+ (progn
+ (while (and s1 (member (car s1) s2))
+ (setq s1 (cdr s1)))
+ (null s1))))))
+
+(defun gnus-server-equal (m1 m2)
+ "Say whether two methods are equal."
+ (let ((m1 (cond ((null m1) gnus-select-method)
+ ((stringp m1) (gnus-server-to-method m1))
+ (t m1)))
+ (m2 (cond ((null m2) gnus-select-method)
+ ((stringp m2) (gnus-server-to-method m2))
+ (t m2))))
+ (gnus-method-equal m1 m2)))
+
+(defun gnus-servers-using-backend (backend)
+ "Return a list of known servers using BACKEND."
+ (let ((opened gnus-opened-servers)
+ out)
+ (while opened
+ (when (eq backend (caaar opened))
+ (push (caar opened) out))
+ (pop opened))
+ out))
+
+(defun gnus-archive-server-wanted-p ()
+ "Say whether the user wants to use the archive server."
+ (cond
+ ((or (not gnus-message-archive-method)
+ (not gnus-message-archive-group))
+ nil)
+ ((and gnus-message-archive-method gnus-message-archive-group)
+ t)
+ (t
+ (let ((active (cadr (assq 'nnfolder-active-file
+ gnus-message-archive-method))))
+ (and active
+ (file-exists-p active))))))
+
+(defun gnus-group-prefixed-name (group method)
+ "Return the whole name from GROUP and METHOD."
+ (and (stringp method) (setq method (gnus-server-to-method method)))
+ (if (not method)
+ group
+ (concat (format "%s" (car method))
+ (when (and
+ (or (assoc (format "%s" (car method))
+ (gnus-methods-using 'address))
+ (gnus-server-equal method gnus-message-archive-method))
+ (nth 1 method)
+ (not (string= (nth 1 method) "")))
+ (concat "+" (nth 1 method)))
+ ":" group)))
+
+(defun gnus-group-real-prefix (group)
+ "Return the prefix of the current group name."
+ (if (string-match "^[^:]+:" group)
+ (substring group 0 (match-end 0))
+ ""))
+
+(defun gnus-group-method (group)
+ "Return the server or method used for selecting GROUP.
+You should probably use `gnus-find-method-for-group' instead."
+ (let ((prefix (gnus-group-real-prefix group)))
+ (if (equal prefix "")
+ gnus-select-method
+ (let ((servers gnus-opened-servers)
+ (server "")
+ backend possible found)
+ (if (string-match "^[^\\+]+\\+" prefix)
+ (setq backend (intern (substring prefix 0 (1- (match-end 0))))
+ server (substring prefix (match-end 0) (1- (length prefix))))
+ (setq backend (intern (substring prefix 0 (1- (length prefix))))))
+ (while servers
+ (when (eq (caaar servers) backend)
+ (setq possible (caar servers))
+ (when (equal (cadaar servers) server)
+ (setq found (caar servers))))
+ (pop servers))
+ (or (car (rassoc found gnus-server-alist))
+ found
+ (car (rassoc possible gnus-server-alist))
+ possible
+ (list backend server))))))
+
+(defsubst gnus-secondary-method-p (method)
+ "Return whether METHOD is a secondary select method."
+ (let ((methods gnus-secondary-select-methods)
+ (gmethod (gnus-server-get-method nil method)))
+ (while (and methods
+ (not (equal (gnus-server-get-method nil (car methods))
+ gmethod)))
+ (setq methods (cdr methods)))
+ methods))
+
+(defun gnus-groups-from-server (server)
+ "Return a list of all groups that are fetched from SERVER."
+ (let ((alist (cdr gnus-newsrc-alist))
+ info groups)
+ (while (setq info (pop alist))
+ (when (gnus-server-equal (gnus-info-method info) server)
+ (push (gnus-info-group info) groups)))
+ (sort groups 'string<)))
+
+(defun gnus-group-foreign-p (group)
+ "Say whether a group is foreign or not."
+ (and (not (gnus-group-native-p group))
+ (not (gnus-group-secondary-p group))))
+
+(defun gnus-group-native-p (group)
+ "Say whether the group is native or not."
+ (not (string-match ":" group)))
+
+(defun gnus-group-secondary-p (group)
+ "Say whether the group is secondary or not."
+ (gnus-secondary-method-p (gnus-find-method-for-group group)))
+
+(defun gnus-group-find-parameter (group &optional symbol)
+ "Return the group parameters for GROUP.
+If SYMBOL, return the value of that symbol in the group parameters."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (let ((parameters (funcall gnus-group-get-parameter-function group)))
+ (if symbol
+ (gnus-group-parameter-value parameters symbol)
+ parameters))))
+
+(defun gnus-group-get-parameter (group &optional symbol)
+ "Return the group parameters for GROUP.
+If SYMBOL, return the value of that symbol in the group parameters."
+ (let ((params (gnus-info-params (gnus-get-info group))))
+ (if symbol
+ (gnus-group-parameter-value params symbol)
+ params)))
+
+(defun gnus-group-parameter-value (params symbol)
+ "Return the value of SYMBOL in group PARAMS."
+ (or (car (memq symbol params)) ; It's either a simple symbol
+ (cdr (assq symbol params)))) ; or a cons.
+
+(defun gnus-group-add-parameter (group param)
+ "Add parameter PARAM to GROUP."
+ (let ((info (gnus-get-info group)))
+ (when info
+ (gnus-group-remove-parameter group (if (consp param) (car param) param))
+ ;; Cons the new param to the old one and update.
+ (gnus-group-set-info (cons param (gnus-info-params info))
+ group 'params))))
+
+(defun gnus-group-set-parameter (group name value)
+ "Set parameter NAME to VALUE in GROUP."
+ (let ((info (gnus-get-info group)))
+ (when info
+ (gnus-group-remove-parameter group name)
+ (let ((old-params (gnus-info-params info))
+ (new-params (list (cons name value))))
+ (while old-params
+ (when (or (not (listp (car old-params)))
+ (not (eq (caar old-params) name)))
+ (setq new-params (append new-params (list (car old-params)))))
+ (setq old-params (cdr old-params)))
+ (gnus-group-set-info new-params group 'params)))))
+
+(defun gnus-group-remove-parameter (group name)
+ "Remove parameter NAME from GROUP."
+ (let ((info (gnus-get-info group)))
+ (when info
+ (let ((params (gnus-info-params info)))
+ (when params
+ (setq params (delq name params))
+ (while (assq name params)
+ (setq params (delq (assq name params) params)))
+ (gnus-info-set-params info params))))))
+
+(defun gnus-group-add-score (group &optional score)
+ "Add SCORE to the GROUP score.
+If SCORE is nil, add 1 to the score of GROUP."
+ (let ((info (gnus-get-info group)))
+ (when info
+ (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
+
+;; Function written by Stainless Steel Rat <ratinox@peorth.gweep.net>
+(defun gnus-short-group-name (group &optional levels)
+ "Collapse GROUP name LEVELS.
+Select methods are stripped and any remote host name is stripped down to
+just the host name."
+ (let* ((name "") (foreign "") (depth -1) (skip 1)
+ (levels (or levels
+ (progn
+ (while (string-match "\\." group skip)
+ (setq skip (match-end 0)
+ depth (+ depth 1)))
+ depth))))
+ ;; separate foreign select method from group name and collapse.
+ ;; if method contains a server, collapse to non-domain server name,
+ ;; otherwise collapse to select method
+ (when (string-match ":" group)
+ (cond ((string-match "+" group)
+ (let* ((plus (string-match "+" group))
+ (colon (string-match ":" group (or plus 0)))
+ (dot (string-match "\\." group)))
+ (setq foreign (concat
+ (substring group (+ 1 plus)
+ (cond ((null dot) colon)
+ ((< colon dot) colon)
+ ((< dot colon) dot)))
+ ":")
+ group (substring group (+ 1 colon)))))
+ (t
+ (let* ((colon (string-match ":" group)))
+ (setq foreign (concat (substring group 0 (+ 1 colon)))
+ group (substring group (+ 1 colon)))))))
+ ;; collapse group name leaving LEVELS uncollapsed elements
+ (while group
+ (if (and (string-match "\\." group) (> levels 0))
+ (setq name (concat name (substring group 0 1))
+ group (substring group (match-end 0))
+ levels (- levels 1)
+ name (concat name "."))
+ (setq name (concat foreign name group)
+ group nil)))
+ name))
+
+(defun gnus-narrow-to-body ()
+ "Narrow to the body of an article."
+ (narrow-to-region
+ (progn
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t)
+ (point-max)))
+ (point-max)))
+
+\f
+;;;
+;;; Kill file handling.
+;;;
+
+(defun gnus-apply-kill-file ()
+ "Apply a kill file to the current newsgroup.
+Returns the number of articles marked as read."
+ (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
+ (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
+ (gnus-apply-kill-file-internal)
+ 0))
+
+(defun gnus-kill-save-kill-buffer ()
+ (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
+ (when (get-file-buffer file)
+ (save-excursion
+ (set-buffer (get-file-buffer file))
+ (when (buffer-modified-p)
+ (save-buffer))
+ (kill-buffer (current-buffer))))))
+
+(defcustom gnus-kill-file-name "KILL"
+ "Suffix of the kill files."
+ :group 'gnus-score-kill
+ :group 'gnus-score-files
+ :type 'string)
+
+(defun gnus-newsgroup-kill-file (newsgroup)
+ "Return the name of a kill file name for NEWSGROUP.
+If NEWSGROUP is nil, return the global kill file name instead."
+ (cond
+ ;; The global KILL file is placed at top of the directory.
+ ((or (null newsgroup)
+ (string-equal newsgroup ""))
+ (expand-file-name gnus-kill-file-name
+ gnus-kill-files-directory))
+ ;; Append ".KILL" to newsgroup name.
+ ((gnus-use-long-file-name 'not-kill)
+ (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
+ "." gnus-kill-file-name)
+ gnus-kill-files-directory))
+ ;; Place "KILL" under the hierarchical directory.
+ (t
+ (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
+ "/" gnus-kill-file-name)
+ gnus-kill-files-directory))))
+
+;;; Server things.
+
+(defun gnus-member-of-valid (symbol group)
+ "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
+ (memq symbol (assoc
+ (symbol-name (car (gnus-find-method-for-group group)))
+ gnus-valid-select-methods)))
+
+(defun gnus-method-option-p (method option)
+ "Return non-nil if select METHOD has OPTION as a parameter."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ (memq option (assoc (format "%s" (car method))
+ gnus-valid-select-methods)))
+
+(defun gnus-similar-server-opened (method)
+ (let ((opened gnus-opened-servers))
+ (while (and method opened)
+ (when (and (equal (cadr method) (cadaar opened))
+ (not (equal method (caar opened))))
+ (setq method nil))
+ (pop opened))
+ (not method)))
+
+(defun gnus-server-extend-method (group method)
+ ;; This function "extends" a virtual server. If the server is
+ ;; "hello", and the select method is ("hello" (my-var "something"))
+ ;; in the group "alt.alt", this will result in a new virtual server
+ ;; called "hello+alt.alt".
+ (if (or (not (inline (gnus-similar-server-opened method)))
+ (not (cddr method)))
+ method
+ `(,(car method) ,(concat (cadr method) "+" group)
+ (,(intern (format "%s-address" (car method))) ,(cadr method))
+ ,@(cddr method))))
+
+(defun gnus-server-status (method)
+ "Return the status of METHOD."
+ (nth 1 (assoc method gnus-opened-servers)))
+
+(defun gnus-group-name-to-method (group)
+ "Guess a select method based on GROUP."
+ (if (string-match ":" group)
+ (let ((server (substring group 0 (match-beginning 0))))
+ (if (string-match "\\+" server)
+ (list (intern (substring server 0 (match-beginning 0)))
+ (substring server (match-end 0)))
+ (list (intern server) "")))
+ gnus-select-method))
+
+(defun gnus-find-method-for-group (group &optional info)
+ "Find the select method that GROUP uses."
+ (or gnus-override-method
+ (and (not group)
+ gnus-select-method)
+ (let ((info (or info (gnus-get-info group)))
+ method)
+ (if (or (not info)
+ (not (setq method (gnus-info-method info)))
+ (equal method "native"))
+ gnus-select-method
+ (setq method
+ (cond ((stringp method)
+ (inline (gnus-server-to-method method)))
+ ((stringp (cadr method))
+ (inline (gnus-server-extend-method group method)))
+ (t
+ method)))
+ (cond ((equal (cadr method) "")
+ method)
+ ((null (cadr method))
+ (list (car method) ""))
+ (t
+ (gnus-server-add-address method)))))))
+
+(defun gnus-methods-using (feature)
+ "Find all methods that have FEATURE."
+ (let ((valids gnus-valid-select-methods)
+ outs)
+ (while valids
+ (when (memq feature (car valids))
+ (push (car valids) outs))
+ (setq valids (cdr valids)))
+ outs))
+
+(defun gnus-read-group (prompt &optional default)
+ "Prompt the user for a group name.
+Disallow illegal group names."
+ (let ((prefix "")
+ group)
+ (while (not group)
+ (when (string-match
+ "[: `'\"/]\\|^$"
+ (setq group (read-string (concat prefix prompt)
+ (cons (or default "") 0)
+ 'gnus-group-history)))
+ (setq prefix (format "Illegal group name: \"%s\". " group)
+ group nil)))
+ group))
+
+(defun gnus-read-method (prompt)
+ "Prompt the user for a method.
+Allow completion over sensible values."
+ (let ((method
+ (completing-read
+ prompt (append gnus-valid-select-methods gnus-predefined-server-alist
+ gnus-server-alist)
+ nil t nil 'gnus-method-history)))
+ (cond
+ ((equal method "")
+ (setq method gnus-select-method))
+ ((assoc method gnus-valid-select-methods)
+ (list (intern method)
+ (if (memq 'prompt-address
+ (assoc method gnus-valid-select-methods))
+ (read-string "Address: ")
+ "")))
+ ((assoc method gnus-server-alist)
+ method)
+ (t
+ (list (intern method) "")))))
+
+;;; User-level commands.
+
+;;;###autoload
+(defun gnus-slave-no-server (&optional arg)
+ "Read network news as a slave, without connecting to local server"
+ (interactive "P")
+ (gnus-no-server arg t))
+
+;;;###autoload
+(defun gnus-no-server (&optional arg slave)
+ "Read network news.
+If ARG is a positive number, Gnus will use that as the
+startup level. If ARG is nil, Gnus will be started at level 2.
+If ARG is non-nil and not a positive number, Gnus will
+prompt the user for the name of an NNTP server to use.
+As opposed to `gnus', this command will not connect to the local server."
+ (interactive "P")
+ (gnus-no-server-1 arg slave))
+
+;;;###autoload
+(defun gnus-slave (&optional arg)
+ "Read news as a slave."
+ (interactive "P")
+ (gnus arg nil 'slave))
+
+;;;###autoload
+(defun gnus-other-frame (&optional arg)
+ "Pop up a frame to read news."
+ (interactive "P")
+ (let ((window (get-buffer-window gnus-group-buffer)))
+ (cond (window
+ (select-frame (window-frame window)))
+ ((= (length (frame-list)) 1)
+ (select-frame (make-frame)))
+ (t
+ (other-frame 1))))
+ (gnus arg))
+
+;;;###autoload
+(defun gnus (&optional arg dont-connect slave)
+ "Read network news.
+If ARG is non-nil and a positive number, Gnus will use that as the
+startup level. If ARG is non-nil and not a positive number, Gnus will
+prompt the user for the name of an NNTP server to use."
+ (interactive "P")
+ (gnus-1 arg dont-connect slave))
+
+;; Allow redefinition of Gnus functions.
+
+(gnus-ems-redefine)
+
+(provide 'gnus)
+
+;;; gnus.el ends here
--- /dev/null
+;; Shut up.
+
+(defvar byte-compile-default-warnings)
+
+(defun maybe-fbind (args)
+ (while args
+ (or (fboundp (car args))
+ (fset (car args) 'ignore))
+ (setq args (cdr args))))
+
+(defun maybe-bind (args)
+ (mapcar (lambda (var) (unless (boundp var) (set var nil))) args))
+
+(if (string-match "XEmacs" emacs-version)
+ (progn
+ (defvar track-mouse nil)
+ (maybe-fbind '(posn-point
+ event-start x-popup-menu
+ facemenu-get-face window-at coordinates-in-window-p
+ compute-motion x-defined-colors easy-menu-create-keymaps
+ read-event internal-find-face internal-next-face-id
+ make-face-internal set-frame-face-alist frame-face-alist
+ facemenu-add-new-face make-face-x-resource-internal
+ set-font-size set-font-family posn-window
+ run-with-idle-timer mouse-minibuffer-check window-edges
+ event-click-count track-mouse read-event mouse-movement-p
+ event-end mouse-scroll-subr overlay-lists delete-overlay
+ set-face-stipple mail-abbrevs-setup char-int
+ make-char-table set-char-table-range font-create-object
+ x-color-values widget-make-intangible error-message-string
+ w3-form-encode-xwfu
+ ))
+ (maybe-bind '(global-face-data
+ mark-active transient-mark-mode mouse-selection-click-count
+ mouse-selection-click-count-buffer buffer-display-table
+ font-lock-defaults user-full-name user-login-name
+ gnus-newsgroup-name gnus-article-x-face-too-ugly)))
+ (defvar browse-url-browser-function nil)
+ (maybe-fbind '(color-instance-rgb-components
+ make-color-instance color-instance-name specifier-instance
+ device-type device-class get-popup-menu-response event-object
+ x-defined-colors read-color add-submenu set-font-family
+ font-create-object set-font-size frame-device find-face
+ set-extent-property make-extent characterp display-error
+ set-face-doc-string frame-property face-doc-string
+ button-press-event-p next-command-event
+ widget-make-intangible glyphp make-glyph set-glyph-image
+ set-glyph-property event-glyph glyph-property event-point
+ device-on-window-system-p make-gui-button Info-goto-node
+ pp-to-string color-name)))
+
+(setq load-path (cons "." load-path))
+(require 'custom)
+
+(provide 'lpath)
--- /dev/null
+;;; mail-header.el --- Mail header parsing, merging, formatting
+
+;; Copyright (C) 1996 by Free Software Foundation, Inc.
+
+;; Author: Erik Naggum <erik@arcana.naggum.no>
+;; Keywords: tools, mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package provides an abstraction to RFC822-style messages, used in
+;; mail news, and some other systems. The simple syntactic rules for such
+;; headers, such as quoting and line folding, are routinely reimplemented
+;; in many individual packages. This package removes the need for this
+;; redundancy by representing message headers as association lists,
+;; offering functions to extract the set of headers from a message, to
+;; parse individual headers, to merge sets of headers, and to format a set
+;; of headers.
+
+;; The car of each element in the message-header alist is a symbol whose
+;; print name is the name of the header, in all lower-case. The cdr of an
+;; element depends on the operation. After extracting headers from a
+;; message, it is a string, the value of the header. An extracted set of
+;; headers may be parsed further, which may turn it into a list, whose car
+;; is the original value and whose subsequent elements depend on the
+;; header. For formatting, it is evaluated to obtain the strings to be
+;; inserted. For merging, one set of headers consists of strings, while
+;; the other set will be evaluated with the symbols in the first set of
+;; headers bound to their respective values.
+
+;;; Code:
+
+(require 'cl)
+
+;; Make the byte-compiler shut up.
+(defvar headers)
+
+(defun mail-header-extract ()
+ "Extract headers from current buffer after point.
+Returns a header alist, where each element is a cons cell (name . value),
+where NAME is a symbol, and VALUE is the string value of the header having
+that name."
+ (let ((message-headers ()) (top (point))
+ start end)
+ (while (and (setq start (point))
+ (> (skip-chars-forward "^\0- :") 0)
+ (= (following-char) ?:)
+ (setq end (point))
+ (progn (forward-char)
+ (> (skip-chars-forward " \t") 0)))
+ (let ((header (intern (downcase (buffer-substring start end))))
+ (value (list (buffer-substring
+ (point) (progn (end-of-line) (point))))))
+ (while (progn (forward-char) (> (skip-chars-forward " \t") 0))
+ (push (buffer-substring (point) (progn (end-of-line) (point)))
+ value))
+ (push (if (cdr value)
+ (cons header (mapconcat #'identity (nreverse value) " "))
+ (cons header (car value)))
+ message-headers)))
+ (goto-char top)
+ (nreverse message-headers)))
+
+(defun mail-header-extract-no-properties ()
+ "Extract headers from current buffer after point, without properties.
+Returns a header alist, where each element is a cons cell (name . value),
+where NAME is a symbol, and VALUE is the string value of the header having
+that name."
+ (mapcar
+ (lambda (elt)
+ (set-text-properties 0 (length (cdr elt)) nil (cdr elt))
+ elt)
+ (mail-header-extract)))
+
+(defun mail-header-parse (parsing-rules headers)
+ "Apply PARSING-RULES to HEADERS.
+PARSING-RULES is an alist whose keys are header names (symbols) and whose
+value is a parsing function. The function takes one argument, a string,
+and return a list of values, which will destructively replace the value
+associated with the key in HEADERS, after being prepended with the original
+value."
+ (dolist (rule parsing-rules)
+ (let ((header (assq (car rule) headers)))
+ (when header
+ (if (consp (cdr header))
+ (setf (cddr header) (funcall (cdr rule) (cadr header)))
+ (setf (cdr header)
+ (cons (cdr header) (funcall (cdr rule) (cdr header))))))))
+ headers)
+
+(defsubst mail-header (header &optional header-alist)
+ "Return the value associated with header HEADER in HEADER-ALIST.
+If the value is a string, it is the original value of the header. If the
+value is a list, its first element is the original value of the header,
+with any subsequent elements being the result of parsing the value.
+If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
+ (cdr (assq header (or header-alist headers))))
+
+(defun mail-header-set (header value &optional header-alist)
+ "Set the value associated with header HEADER to VALUE in HEADER-ALIST.
+HEADER-ALIST defaults to the dynamically bound variable `headers' if nil.
+See `mail-header' for the semantics of VALUE."
+ (let* ((alist (or header-alist headers))
+ (entry (assq header alist)))
+ (if entry
+ (setf (cdr entry) value)
+ (nconc alist (list (cons header value)))))
+ value)
+
+(defsetf mail-header (header &optional header-alist) (value)
+ `(mail-header-set ,header ,value ,header-alist))
+
+(defun mail-header-merge (merge-rules headers)
+ "Return a new header alist with MERGE-RULES applied to HEADERS.
+MERGE-RULES is an alist whose keys are header names (symbols) and whose
+values are forms to evaluate, the results of which are the new headers. It
+should be a string or a list of string. The first element may be nil to
+denote that the formatting functions must use the remaining elements, or
+skip the header altogether if there are no other elements.
+ The macro `mail-header' can be used to access headers in HEADERS."
+ (mapcar
+ (lambda (rule)
+ (cons (car rule) (eval (cdr rule))))
+ merge-rules))
+
+(defvar mail-header-format-function
+ (lambda (header value)
+ "Function to format headers without a specified formatting function."
+ (insert (capitalize (symbol-name header))
+ ": "
+ (if (consp value) (car value) value)
+ "\n")))
+
+(defun mail-header-format (format-rules headers)
+ "Use FORMAT-RULES to format HEADERS and insert into current buffer.
+FORMAT-RULES is an alist whose keys are header names (symbols), and whose
+values are functions that format the header, the results of which are
+inserted, unless it is nil. The function takes two arguments, the header
+symbol, and the value of that header. If the function itself is nil, the
+default action is to insert the value of the header, unless it is nil.
+The headers are inserted in the order of the FORMAT-RULES.
+A key of t represents any otherwise unmentioned headers.
+A key of nil has as its value a list of defaulted headers to ignore."
+ (let ((ignore (append (cdr (assq nil format-rules))
+ (mapcar #'car format-rules))))
+ (dolist (rule format-rules)
+ (let* ((header (car rule))
+ (value (mail-header header)))
+ (cond ((null header) 'ignore)
+ ((eq header t)
+ (dolist (defaulted headers)
+ (unless (memq (car defaulted) ignore)
+ (let* ((header (car defaulted))
+ (value (cdr defaulted)))
+ (if (cdr rule)
+ (funcall (cdr rule) header value)
+ (funcall mail-header-format-function header value))))))
+ (value
+ (if (cdr rule)
+ (funcall (cdr rule) header value)
+ (funcall mail-header-format-function header value))))))
+ (insert "\n")))
+
+(provide 'mailheader)
+
+;;; mail-header.el ends here
--- /dev/null
+;;; md5.el -- MD5 Message Digest Algorithm
+;;; Gareth Rees <gdr11@cl.cam.ac.uk>
+
+;; LCD Archive Entry:
+;; md5|Gareth Rees|gdr11@cl.cam.ac.uk|
+;; MD5 cryptographic message digest algorithm|
+;; 13-Nov-95|1.0|~/misc/md5.el.Z|
+
+;;; Details: ------------------------------------------------------------------
+
+;; This is a direct translation into Emacs LISP of the reference C
+;; implementation of the MD5 Message-Digest Algorithm written by RSA
+;; Data Security, Inc.
+;;
+;; The algorithm takes a message (that is, a string of bytes) and
+;; computes a 16-byte checksum or "digest" for the message. This digest
+;; is supposed to be cryptographically strong in the sense that if you
+;; are given a 16-byte digest D, then there is no easier way to
+;; construct a message whose digest is D than to exhaustively search the
+;; space of messages. However, the robustness of the algorithm has not
+;; been proven, and a similar algorithm (MD4) was shown to be unsound,
+;; so treat with caution!
+;;
+;; The C algorithm uses 32-bit integers; because GNU Emacs
+;; implementations provide 28-bit integers (with 24-bit integers on
+;; versions prior to 19.29), the code represents a 32-bit integer as the
+;; cons of two 16-bit integers. The most significant word is stored in
+;; the car and the least significant in the cdr. The algorithm requires
+;; at least 17 bits of integer representation in order to represent the
+;; carry from a 16-bit addition.
+
+;;; Usage: --------------------------------------------------------------------
+
+;; To compute the MD5 Message Digest for a message M (represented as a
+;; string or as a vector of bytes), call
+;;
+;; (md5-encode M)
+;;
+;; which returns the message digest as a vector of 16 bytes. If you
+;; need to supply the message in pieces M1, M2, ... Mn, then call
+;;
+;; (md5-init)
+;; (md5-update M1)
+;; (md5-update M2)
+;; ...
+;; (md5-update Mn)
+;; (md5-final)
+
+;;; Copyright and licence: ----------------------------------------------------
+
+;; Copyright (C) 1995 by Gareth Rees
+;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm
+;;
+;; md5.el 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 2, or (at your option) any
+;; later version.
+;;
+;; md5.el 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.
+;;
+;; The original copyright notice is given below, as required by the
+;; licence for the original code. This code is distributed under *both*
+;; RSA's original licence and the GNU General Public Licence. (There
+;; should be no problems, as the former is more liberal than the
+;; latter).
+
+;;; Original copyright notice: ------------------------------------------------
+
+;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved.
+;;
+;; License to copy and use this software is granted provided that it is
+;; identified as the "RSA Data Security, Inc. MD5 Message- Digest
+;; Algorithm" in all material mentioning or referencing this software or
+;; this function.
+;;
+;; License is also granted to make and use derivative works provided
+;; that such works are identified as "derived from the RSA Data
+;; Security, Inc. MD5 Message-Digest Algorithm" in all material
+;; mentioning or referencing the derived work.
+;;
+;; RSA Data Security, Inc. makes no representations concerning either
+;; the merchantability of this software or the suitability of this
+;; software for any particular purpose. It is provided "as is" without
+;; express or implied warranty of any kind.
+;;
+;; These notices must be retained in any copies of any part of this
+;; documentation and/or software.
+
+;;; Code: ---------------------------------------------------------------------
+
+(defvar md5-program "md5"
+ "*Program that reads a message on its standard input and writes an
+MD5 digest on its output.")
+
+(defvar md5-maximum-internal-length 4096
+ "*The maximum size of a piece of data that should use the MD5 routines
+written in lisp. If a message exceeds this, it will be run through an
+external filter for processing. Also see the `md5-program' variable.
+This variable has no effect if you call the md5-init|update|final
+functions - only used by the `md5' function's simpler interface.")
+
+(defvar md5-bits (make-vector 4 0)
+ "Number of bits handled, modulo 2^64.
+Represented as four 16-bit numbers, least significant first.")
+(defvar md5-buffer (make-vector 4 '(0 . 0))
+ "Scratch buffer (four 32-bit integers).")
+(defvar md5-input (make-vector 64 0)
+ "Input buffer (64 bytes).")
+
+(defun md5-unhex (x)
+ (if (> x ?9)
+ (if (>= x ?a)
+ (+ 10 (- x ?a))
+ (+ 10 (- x ?A)))
+ (- x ?0)))
+
+(defun md5-encode (message)
+ "Encodes MESSAGE using the MD5 message digest algorithm.
+MESSAGE must be a string or an array of bytes.
+Returns a vector of 16 bytes containing the message digest."
+ (if (<= (length message) md5-maximum-internal-length)
+ (progn
+ (md5-init)
+ (md5-update message)
+ (md5-final))
+ (save-excursion
+ (set-buffer (get-buffer-create " *md5-work*"))
+ (erase-buffer)
+ (insert message)
+ (call-process-region (point-min) (point-max)
+ (or shell-file-name "/bin/sh")
+ t (current-buffer) nil
+ "-c" md5-program)
+ ;; MD5 digest is 32 chars long
+ ;; mddriver adds a newline to make neaten output for tty
+ ;; viewing, make sure we leave it behind.
+ (let ((data (buffer-substring (point-min) (+ (point-min) 32)))
+ (vec (make-vector 16 0))
+ (ctr 0))
+ (while (< ctr 16)
+ (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2))))
+ (md5-unhex (aref data (1+ (* ctr 2))))))
+ (setq ctr (1+ ctr)))))))
+
+(defsubst md5-add (x y)
+ "Return 32-bit sum of 32-bit integers X and Y."
+ (let ((m (+ (car x) (car y)))
+ (l (+ (cdr x) (cdr y))))
+ (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535))))
+
+;; FF, GG, HH and II are basic MD5 functions, providing transformations
+;; for rounds 1, 2, 3 and 4 respectively. Each function follows this
+;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x
+;; by y bits to the left):
+;;
+;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b
+;;
+;; so we use the macro `md5-make-step' to construct each one. The
+;; helper functions F, G, H and I operate on 16-bit numbers; the full
+;; operation splits its inputs, operates on the halves separately and
+;; then puts the results together.
+
+(defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z)))
+(defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z))))
+(defsubst md5-H (x y z) (logxor x y z))
+(defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z)))))
+
+(defmacro md5-make-step (name func)
+ (`
+ (defun (, name) (a b c d x s ac)
+ (let*
+ ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac)))
+ (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac)))
+ (m2 (logand 65535 (+ m1 (lsh l1 -16))))
+ (l2 (logand 65535 l1))
+ (m3 (logand 65535 (if (> s 15)
+ (+ (lsh m2 (- s 32)) (lsh l2 (- s 16)))
+ (+ (lsh m2 s) (lsh l2 (- s 16))))))
+ (l3 (logand 65535 (if (> s 15)
+ (+ (lsh l2 (- s 32)) (lsh m2 (- s 16)))
+ (+ (lsh l2 s) (lsh m2 (- s 16)))))))
+ (md5-add (cons m3 l3) b)))))
+
+(md5-make-step md5-FF md5-F)
+(md5-make-step md5-GG md5-G)
+(md5-make-step md5-HH md5-H)
+(md5-make-step md5-II md5-I)
+
+(defun md5-init ()
+ "Initialise the state of the message-digest routines."
+ (aset md5-bits 0 0)
+ (aset md5-bits 1 0)
+ (aset md5-bits 2 0)
+ (aset md5-bits 3 0)
+ (aset md5-buffer 0 '(26437 . 8961))
+ (aset md5-buffer 1 '(61389 . 43913))
+ (aset md5-buffer 2 '(39098 . 56574))
+ (aset md5-buffer 3 '( 4146 . 21622)))
+
+(defun md5-update (string)
+ "Update the current MD5 state with STRING (an array of bytes)."
+ (let ((len (length string))
+ (i 0)
+ (j 0))
+ (while (< i len)
+ ;; Compute number of bytes modulo 64
+ (setq j (% (/ (aref md5-bits 0) 8) 64))
+
+ ;; Store this byte (truncating to 8 bits to be sure)
+ (aset md5-input j (logand 255 (aref string i)))
+
+ ;; Update number of bits by 8 (modulo 2^64)
+ (let ((c 8) (k 0))
+ (while (and (> c 0) (< k 4))
+ (let ((b (aref md5-bits k)))
+ (aset md5-bits k (logand 65535 (+ b c)))
+ (setq c (if (> b (- 65535 c)) 1 0)
+ k (1+ k)))))
+
+ ;; Increment number of bytes processed
+ (setq i (1+ i))
+
+ ;; When 64 bytes accumulated, pack them into sixteen 32-bit
+ ;; integers in the array `in' and then tranform them.
+ (if (= j 63)
+ (let ((in (make-vector 16 (cons 0 0)))
+ (k 0)
+ (kk 0))
+ (while (< k 16)
+ (aset in k (md5-pack md5-input kk))
+ (setq k (+ k 1) kk (+ kk 4)))
+ (md5-transform in))))))
+
+(defun md5-pack (array i)
+ "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer."
+ (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2)))
+ (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0)))))
+
+(defun md5-byte (array n b)
+ "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers."
+ (let ((e (aref array n)))
+ (cond ((eq b 0) (logand 255 (cdr e)))
+ ((eq b 1) (lsh (cdr e) -8))
+ ((eq b 2) (logand 255 (car e)))
+ ((eq b 3) (lsh (car e) -8)))))
+
+(defun md5-final ()
+ (let ((in (make-vector 16 (cons 0 0)))
+ (j 0)
+ (digest (make-vector 16 0))
+ (padding))
+
+ ;; Save the number of bits in the message
+ (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0)))
+ (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2)))
+
+ ;; Compute number of bytes modulo 64
+ (setq j (% (/ (aref md5-bits 0) 8) 64))
+
+ ;; Pad out computation to 56 bytes modulo 64
+ (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0))
+ (aset padding 0 128)
+ (md5-update padding)
+
+ ;; Append length in bits and transform
+ (let ((k 0) (kk 0))
+ (while (< k 14)
+ (aset in k (md5-pack md5-input kk))
+ (setq k (+ k 1) kk (+ kk 4))))
+ (md5-transform in)
+
+ ;; Store the results in the digest
+ (let ((k 0) (kk 0))
+ (while (< k 4)
+ (aset digest (+ kk 0) (md5-byte md5-buffer k 0))
+ (aset digest (+ kk 1) (md5-byte md5-buffer k 1))
+ (aset digest (+ kk 2) (md5-byte md5-buffer k 2))
+ (aset digest (+ kk 3) (md5-byte md5-buffer k 3))
+ (setq k (+ k 1) kk (+ kk 4))))
+
+ ;; Return digest
+ digest))
+
+;; It says in the RSA source, "Note that if the Mysterious Constants are
+;; arranged backwards in little-endian order and decrypted with the DES
+;; they produce OCCULT MESSAGES!" Security through obscurity?
+
+(defun md5-transform (in)
+ "Basic MD5 step. Transform md5-buffer based on array IN."
+ (let ((a (aref md5-buffer 0))
+ (b (aref md5-buffer 1))
+ (c (aref md5-buffer 2))
+ (d (aref md5-buffer 3)))
+ (setq
+ a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104))
+ d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934))
+ c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891))
+ b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974))
+ a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015))
+ d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730))
+ c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939))
+ b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145))
+ a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128))
+ d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407))
+ c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473))
+ b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230))
+ a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386))
+ d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075))
+ c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294))
+ b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081))
+ a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570))
+ d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888))
+ c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121))
+ b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114))
+ a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189))
+ d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203))
+ c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009))
+ b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456))
+ a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710))
+ d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006))
+ c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463))
+ b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357))
+ a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653))
+ d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976))
+ c (md5-GG c d a b (aref in 7) 14 '(26479 . 729))
+ b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594))
+ a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658))
+ d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105))
+ c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866))
+ b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348))
+ a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972))
+ d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161))
+ c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296))
+ b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240))
+ a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454))
+ d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234))
+ c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421))
+ b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429))
+ a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305))
+ d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397))
+ c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992))
+ b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117))
+ a (md5-II a b c d (aref in 0) 6 '(62505 . 8772))
+ d (md5-II d a b c (aref in 7) 10 '(17194 . 65431))
+ c (md5-II c d a b (aref in 14) 15 '(43924 . 9127))
+ b (md5-II b c d a (aref in 5) 21 '(64659 . 41017))
+ a (md5-II a b c d (aref in 12) 6 '(25947 . 22979))
+ d (md5-II d a b c (aref in 3) 10 '(36620 . 52370))
+ c (md5-II c d a b (aref in 10) 15 '(65519 . 62589))
+ b (md5-II b c d a (aref in 1) 21 '(34180 . 24017))
+ a (md5-II a b c d (aref in 8) 6 '(28584 . 32335))
+ d (md5-II d a b c (aref in 15) 10 '(65068 . 59104))
+ c (md5-II c d a b (aref in 6) 15 '(41729 . 17172))
+ b (md5-II b c d a (aref in 13) 21 '(19976 . 4513))
+ a (md5-II a b c d (aref in 4) 6 '(63315 . 32386))
+ d (md5-II d a b c (aref in 11) 10 '(48442 . 62005))
+ c (md5-II c d a b (aref in 2) 15 '(10967 . 53947))
+ b (md5-II b c d a (aref in 9) 21 '(60294 . 54161)))
+
+ (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a))
+ (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b))
+ (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c))
+ (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Here begins the merger with the XEmacs API and the md5.el from the URL
+;;; package. Courtesy wmperry@spry.com
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun md5 (object &optional start end)
+ "Return the MD5 (a secure message digest algorithm) of an object.
+OBJECT is either a string or a buffer.
+Optional arguments START and END denote buffer positions for computing the
+hash of a portion of OBJECT."
+ (let ((buffer nil))
+ (unwind-protect
+ (save-excursion
+ (setq buffer (generate-new-buffer " *md5-work*"))
+ (set-buffer buffer)
+ (cond
+ ((bufferp object)
+ (insert-buffer-substring object start end))
+ ((stringp object)
+ (insert (if (or start end)
+ (substring object start end)
+ object)))
+ (t nil))
+ (prog1
+ (if (<= (point-max) md5-maximum-internal-length)
+ (mapconcat
+ (function (lambda (node) (format "%02x" node)))
+ (md5-encode (buffer-string))
+ "")
+ (call-process-region (point-min) (point-max)
+ (or shell-file-name "/bin/sh")
+ t buffer nil
+ "-c" md5-program)
+ ;; MD5 digest is 32 chars long
+ ;; mddriver adds a newline to make neaten output for tty
+ ;; viewing, make sure we leave it behind.
+ (buffer-substring (point-min) (+ (point-min) 32)))
+ (kill-buffer buffer)))
+ (and buffer (kill-buffer buffer) nil))))
+
+(provide 'md5)
+
+;;; md5.el ends here ----------------------------------------------------------
--- /dev/null
+;;; message.el --- composing mail and news messages
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This mode provides mail-sending facilities from within Emacs. It
+;; consists mainly of large chunks of code from the sendmail.el,
+;; gnus-msg.el and rnewspost.el files.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'mailheader)
+(require 'rmail)
+(require 'nnheader)
+(require 'timezone)
+(require 'easymenu)
+(require 'custom)
+(if (string-match "XEmacs\\|Lucid" emacs-version)
+ (require 'mail-abbrevs)
+ (require 'mailabbrev))
+
+(defgroup message '((user-mail-address custom-variable)
+ (user-full-name custom-variable))
+ "Mail and news message composing."
+ :link '(custom-manual "(message)Top")
+ :group 'mail
+ :group 'news)
+
+(put 'user-mail-address 'custom-type 'string)
+(put 'user-full-name 'custom-type 'string)
+
+(defgroup message-various nil
+ "Various Message Variables"
+ :link '(custom-manual "(message)Various Message Variables")
+ :group 'message)
+
+(defgroup message-buffers nil
+ "Message Buffers"
+ :link '(custom-manual "(message)Message Buffers")
+ :group 'message)
+
+(defgroup message-sending nil
+ "Message Sending"
+ :link '(custom-manual "(message)Sending Variables")
+ :group 'message)
+
+(defgroup message-interface nil
+ "Message Interface"
+ :link '(custom-manual "(message)Interface")
+ :group 'message)
+
+(defgroup message-forwarding nil
+ "Message Forwarding"
+ :link '(custom-manual "(message)Forwarding")
+ :group 'message-interface)
+
+(defgroup message-insertion nil
+ "Message Insertion"
+ :link '(custom-manual "(message)Insertion")
+ :group 'message)
+
+(defgroup message-headers nil
+ "Message Headers"
+ :link '(custom-manual "(message)Message Headers")
+ :group 'message)
+
+(defgroup message-news nil
+ "Composing News Messages"
+ :group 'message)
+
+(defgroup message-mail nil
+ "Composing Mail Messages"
+ :group 'message)
+
+(defgroup message-faces nil
+ "Faces used for message composing."
+ :group 'message
+ :group 'faces)
+
+(defcustom message-directory "~/Mail/"
+ "*Directory from which all other mail file variables are derived."
+ :group 'message-various
+ :type 'directory)
+
+(defcustom message-max-buffers 10
+ "*How many buffers to keep before starting to kill them off."
+ :group 'message-buffers
+ :type 'integer)
+
+(defcustom message-send-rename-function nil
+ "Function called to rename the buffer after sending it."
+ :group 'message-buffers
+ :type 'function)
+
+(defcustom message-fcc-handler-function 'message-output
+ "*A function called to save outgoing articles.
+This function will be called with the name of the file to store the
+article in. The default function is `message-output' which saves in Unix
+mailbox format."
+ :type '(radio (function-item message-output)
+ (function :tag "Other"))
+ :group 'message-sending)
+
+(defcustom message-courtesy-message
+ "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
+ "*This is inserted at the start of a mailed copy of a posted message.
+If the string contains the format spec \"%s\", the Newsgroups
+the article has been posted to will be inserted there.
+If this variable is nil, no such courtesy message will be added."
+ :group 'message-sending
+ :type 'string)
+
+(defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):"
+ "*Regexp that matches headers to be removed in resent bounced mail."
+ :group 'message-interface
+ :type 'regexp)
+
+;;;###autoload
+(defcustom message-from-style 'default
+ "*Specifies how \"From\" headers look.
+
+If `nil', they contain just the return address like:
+ king@grassland.com
+If `parens', they look like:
+ king@grassland.com (Elvis Parsley)
+If `angles', they look like:
+ Elvis Parsley <king@grassland.com>
+
+Otherwise, most addresses look like `angles', but they look like
+`parens' if `angles' would need quoting and `parens' would not."
+ :type '(choice (const :tag "simple" nil)
+ (const parens)
+ (const angles)
+ (const default))
+ :group 'message-headers)
+
+(defcustom message-syntax-checks nil
+ ;; Guess this one shouldn't be easy to customize...
+ "Controls what syntax checks should not be performed on outgoing posts.
+To disable checking of long signatures, for instance, add
+ `(signature . disabled)' to this list.
+
+Don't touch this variable unless you really know what you're doing.
+
+Checks include subject-cmsg multiple-headers sendsys message-id from
+long-lines control-chars size new-text redirected-followup signature
+approved sender empty empty-headers message-id from subject
+shorten-followup-to existing-newsgroups buffer-file-name unchanged."
+ :group 'message-news)
+
+(defcustom message-required-news-headers
+ '(From Newsgroups Subject Date Message-ID
+ (optional . Organization) Lines
+ (optional . X-Newsreader))
+ "Headers to be generated or prompted for when posting an article.
+RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
+Message-ID. Organization, Lines, In-Reply-To, Expires, and
+X-Newsreader are optional. If don't you want message to insert some
+header, remove it from this list."
+ :group 'message-news
+ :group 'message-headers
+ :type '(repeat sexp))
+
+(defcustom message-required-mail-headers
+ '(From Subject Date (optional . In-Reply-To) Message-ID Lines
+ (optional . X-Mailer))
+ "Headers to be generated or prompted for when mailing a message.
+RFC822 required that From, Date, To, Subject and Message-ID be
+included. Organization, Lines and X-Mailer are optional."
+ :group 'message-mail
+ :group 'message-headers
+ :type '(repeat sexp))
+
+(defcustom message-deletable-headers '(Message-ID Date Lines)
+ "Headers to be deleted if they already exist and were generated by message previously."
+ :group 'message-headers
+ :type 'sexp)
+
+(defcustom message-ignored-news-headers
+ "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:\\|^Resent-Fcc:"
+ "*Regexp of headers to be removed unconditionally before posting."
+ :group 'message-news
+ :group 'message-headers
+ :type 'regexp)
+
+(defcustom message-ignored-mail-headers "^Gcc:\\|^Fcc:\\|^Resent-Fcc:"
+ "*Regexp of headers to be removed unconditionally before mailing."
+ :group 'message-mail
+ :group 'message-headers
+ :type 'regexp)
+
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:"
+ "*Header lines matching this regexp will be deleted before posting.
+It's best to delete old Path and Date headers before posting to avoid
+any confusion."
+ :group 'message-interface
+ :type 'regexp)
+
+;;;###autoload
+(defcustom message-signature-separator "^-- *$"
+ "Regexp matching the signature separator."
+ :type 'regexp
+ :group 'message-various)
+
+(defcustom message-elide-elipsis "\n[...]\n\n"
+ "*The string which is inserted for elided text.")
+
+(defcustom message-interactive nil
+ "Non-nil means when sending a message wait for and display errors.
+nil means let mailer mail back a message to report errors."
+ :group 'message-sending
+ :group 'message-mail
+ :type 'boolean)
+
+(defcustom message-generate-new-buffers t
+ "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.
+If this is a function, call that function with three parameters: The type,
+the to address and the group name. (Any of these may be nil.) The function
+should return the new buffer name."
+ :group 'message-buffers
+ :type '(choice (const :tag "off" nil)
+ (const :tag "on" t)
+ (function fun)))
+
+(defcustom message-kill-buffer-on-exit nil
+ "*Non-nil means that the message buffer will be killed after sending a message."
+ :group 'message-buffers
+ :type 'boolean)
+
+(defvar gnus-local-organization)
+(defcustom message-user-organization
+ (or (and (boundp 'gnus-local-organization)
+ (stringp gnus-local-organization)
+ gnus-local-organization)
+ (getenv "ORGANIZATION")
+ t)
+ "*String to be used as an Organization header.
+If t, use `message-user-organization-file'."
+ :group 'message-headers
+ :type '(choice string
+ (const :tag "consult file" t)))
+
+;;;###autoload
+(defcustom message-user-organization-file "/usr/lib/news/organization"
+ "*Local news organization file."
+ :type 'file
+ :group 'message-headers)
+
+(defcustom message-autosave-directory
+ (nnheader-concat message-directory "drafts/")
+ "*Directory where Message autosaves buffers.
+If nil, Message won't autosave."
+ :group 'message-buffers
+ :type 'directory)
+
+(defcustom message-forward-start-separator
+ "------- Start of forwarded message -------\n"
+ "*Delimiter inserted before forwarded messages."
+ :group 'message-forwarding
+ :type 'string)
+
+(defcustom message-forward-end-separator
+ "------- End of forwarded message -------\n"
+ "*Delimiter inserted after forwarded messages."
+ :group 'message-forwarding
+ :type 'string)
+
+(defcustom message-signature-before-forwarded-message t
+ "*If non-nil, put the signature before any included forwarded message."
+ :group 'message-forwarding
+ :type 'boolean)
+
+(defcustom message-included-forward-headers
+ "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:"
+ "*Regexp matching headers to be included in forwarded messages."
+ :group 'message-forwarding
+ :type 'regexp)
+
+(defcustom message-ignored-resent-headers "^Return-receipt"
+ "*All headers that match this regexp will be deleted when resending a message."
+ :group 'message-interface
+ :type 'regexp)
+
+(defcustom message-ignored-cited-headers "."
+ "*Delete these headers from the messages you yank."
+ :group 'message-insertion
+ :type 'regexp)
+
+(defcustom message-cancel-message "I am canceling my own article."
+ "Message to be inserted in the cancel message."
+ :group 'message-interface
+ :type 'string)
+
+;; Useful to set in site-init.el
+;;;###autoload
+(defcustom message-send-mail-function 'message-send-mail-with-sendmail
+ "Function to call to send the current buffer as mail.
+The headers should be delimited by a line whose contents match the
+variable `mail-header-separator'.
+
+Legal values include `message-send-mail-with-sendmail' (the default),
+`message-send-mail-with-mh' and `message-send-mail-with-qmail'."
+ :type '(radio (function-item message-send-mail-with-sendmail)
+ (function-item message-send-mail-with-mh)
+ (function-item message-send-mail-with-qmail)
+ (function :tag "Other"))
+ :group 'message-sending
+ :group 'message-mail)
+
+(defcustom message-send-news-function 'message-send-news
+ "Function to call to send the current buffer as news.
+The headers should be delimited by a line whose contents match the
+variable `mail-header-separator'."
+ :group 'message-sending
+ :group 'message-news
+ :type 'function)
+
+(defcustom message-reply-to-function nil
+ "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers."
+ :group 'message-interface
+ :type 'function)
+
+(defcustom message-wide-reply-to-function nil
+ "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers."
+ :group 'message-interface
+ :type 'function)
+
+(defcustom message-followup-to-function nil
+ "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers."
+ :group 'message-interface
+ :type 'function)
+
+(defcustom message-use-followup-to 'ask
+ "*Specifies what to do with Followup-To header.
+If nil, always ignore the header. If it is t, use its value, but
+query before using the \"poster\" value. If it is the symbol `ask',
+always query the user whether to use the value. If it is the symbol
+`use', always use the value."
+ :group 'message-interface
+ :type '(choice (const :tag "ignore" nil)
+ (const use)
+ (const ask)))
+
+;; stuff relating to broken sendmail in MMDF
+(defcustom message-sendmail-f-is-evil nil
+ "*Non-nil means that \"-f username\" should not be added to the sendmail
+command line, because it is even more evil than leaving it out."
+ :group 'message-sending
+ :type 'boolean)
+
+;; qmail-related stuff
+(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
+ "Location of the qmail-inject program."
+ :group 'message-sending
+ :type 'file)
+
+(defcustom message-qmail-inject-args nil
+ "Arguments passed to qmail-inject programs.
+This should be a list of strings, one string for each argument.
+
+For e.g., if you wish to set the envelope sender address so that bounces
+go to the right place or to deal with listserv's usage of that address, you
+might set this variable to '(\"-f\" \"you@some.where\")."
+ :group 'message-sending
+ :type '(repeat string))
+
+(defvar gnus-post-method)
+(defvar gnus-select-method)
+(defcustom message-post-method
+ (cond ((and (boundp 'gnus-post-method)
+ gnus-post-method)
+ gnus-post-method)
+ ((boundp 'gnus-select-method)
+ gnus-select-method)
+ (t '(nnspool "")))
+ "Method used to post news."
+ :group 'message-news
+ :group 'message-sending
+ ;; This should be the `gnus-select-method' widget, but that might
+ ;; create a dependence to `gnus.el'.
+ :type 'sexp)
+
+(defcustom message-generate-headers-first nil
+ "*If non-nil, generate all possible headers before composing."
+ :group 'message-headers
+ :type 'boolean)
+
+(defcustom message-setup-hook nil
+ "Normal hook, run each time a new outgoing message is initialized.
+The function `message-setup' runs this hook."
+ :group 'message-various
+ :type 'hook)
+
+(defcustom message-signature-setup-hook nil
+ "Normal hook, run each time a new outgoing message is initialized.
+It is run after the headers have been inserted and before
+the signature is inserted."
+ :group 'message-various
+ :type 'hook)
+
+(defcustom message-mode-hook nil
+ "Hook run in message mode buffers."
+ :group 'message-various
+ :type 'hook)
+
+(defcustom message-header-hook nil
+ "Hook run in a message mode buffer narrowed to the headers."
+ :group 'message-various
+ :type 'hook)
+
+(defcustom message-header-setup-hook nil
+ "Hook called narrowed to the headers when setting up a message
+buffer."
+ :group 'message-various
+ :type 'hook)
+
+;;;###autoload
+(defcustom message-citation-line-function 'message-insert-citation-line
+ "*Function called to insert the \"Whomever writes:\" line."
+ :type 'function
+ :group 'message-insertion)
+
+;;;###autoload
+(defcustom message-yank-prefix "> "
+ "*Prefix inserted on the lines of yanked messages.
+nil means use indentation."
+ :type 'string
+ :group 'message-insertion)
+
+(defcustom message-indentation-spaces 3
+ "*Number of spaces to insert at the beginning of each cited line.
+Used by `message-yank-original' via `message-yank-cite'."
+ :group 'message-insertion
+ :type 'integer)
+
+;;;###autoload
+(defcustom message-cite-function
+ (if (and (boundp 'mail-citation-hook)
+ mail-citation-hook)
+ mail-citation-hook
+ 'message-cite-original)
+ "*Function for citing an original message."
+ :type '(radio (function-item message-cite-original)
+ (function-item sc-cite-original)
+ (function :tag "Other"))
+ :group 'message-insertion)
+
+;;;###autoload
+(defcustom message-indent-citation-function 'message-indent-citation
+ "*Function for modifying a citation just inserted in the mail buffer.
+This can also be a list of functions. Each function can find the
+citation between (point) and (mark t). And each function should leave
+point and mark around the citation text as modified."
+ :type 'function
+ :group 'message-insertion)
+
+(defvar message-abbrevs-loaded nil)
+
+;;;###autoload
+(defcustom message-signature t
+ "*String to be inserted at the end of the message buffer.
+If t, the `message-signature-file' file will be inserted instead.
+If a function, the result from the function will be used instead.
+If a form, the result from the form will be used instead."
+ :type 'sexp
+ :group 'message-insertion)
+
+;;;###autoload
+(defcustom message-signature-file "~/.signature"
+ "*File containing the text inserted at end of message buffer."
+ :type 'file
+ :group 'message-insertion)
+
+(defcustom message-distribution-function nil
+ "*Function called to return a Distribution header."
+ :group 'message-news
+ :group 'message-headers
+ :type 'function)
+
+(defcustom message-expires 14
+ "Number of days before your article expires."
+ :group 'message-news
+ :group 'message-headers
+ :link '(custom-manual "(message)News Headers")
+ :type 'integer)
+
+(defcustom message-user-path nil
+ "If nil, use the NNTP server name in the Path header.
+If stringp, use this; if non-nil, use no host name (user name only)."
+ :group 'message-news
+ :group 'message-headers
+ :link '(custom-manual "(message)News Headers")
+ :type '(choice (const :tag "nntp" nil)
+ (string :tag "name")
+ (sexp :tag "none" :format "%t" t)))
+
+(defvar message-reply-buffer nil)
+(defvar message-reply-headers nil)
+(defvar message-newsreader nil)
+(defvar message-mailer nil)
+(defvar message-sent-message-via nil)
+(defvar message-checksum nil)
+(defvar message-send-actions nil
+ "A list of actions to be performed upon successful sending of a message.")
+(defvar message-exit-actions nil
+ "A list of actions to be performed upon exiting after sending a message.")
+(defvar message-kill-actions nil
+ "A list of actions to be performed before killing a message buffer.")
+(defvar message-postpone-actions nil
+ "A list of actions to be performed after postponing a message.")
+
+(defcustom message-default-headers ""
+ "*A string containing header lines to be inserted in outgoing messages.
+It is inserted before you edit the message, so you can edit or delete
+these lines."
+ :group 'message-headers
+ :type 'string)
+
+(defcustom message-default-mail-headers ""
+ "*A string of header lines to be inserted in outgoing mails."
+ :group 'message-headers
+ :group 'message-mail
+ :type 'string)
+
+(defcustom message-default-news-headers ""
+ "*A string of header lines to be inserted in outgoing news
+articles."
+ :group 'message-headers
+ :group 'message-news
+ :type 'string)
+
+;; Note: could use /usr/ucb/mail instead of sendmail;
+;; options -t, and -v if not interactive.
+(defcustom message-mailer-swallows-blank-line
+ (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)"
+ system-configuration)
+ (file-readable-p "/etc/sendmail.cf")
+ (let ((buffer (get-buffer-create " *temp*")))
+ (unwind-protect
+ (save-excursion
+ (set-buffer buffer)
+ (insert-file-contents "/etc/sendmail.cf")
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (re-search-forward "^OR\\>" nil t)))
+ (kill-buffer buffer))))
+ ;; According to RFC822, "The field-name must be composed of printable
+ ;; ASCII characters (i. e., characters that have decimal values between
+ ;; 33 and 126, except colon)", i. e., any chars except ctl chars,
+ ;; space, or colon.
+ '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
+ "Set this non-nil if the system's mailer runs the header and body together.
+\(This problem exists on Sunos 4 when sendmail is run in remote mode.)
+The value should be an expression to test whether the problem will
+actually occur."
+ :group 'message-sending
+ :type 'sexp)
+
+;; Ignore errors in case this is used in Emacs 19.
+;; Don't use ignore-errors because this is copied into loaddefs.el.
+;;;###autoload
+(condition-case nil
+ (define-mail-user-agent 'message-user-agent
+ 'message-mail 'message-send-and-exit
+ 'message-kill-buffer 'message-send-hook)
+ (error nil))
+
+(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
+ "If non-nil, delete the deletable headers before feeding to mh.")
+
+(defvar message-send-method-alist
+ '((news message-news-p message-send-via-news)
+ (mail message-mail-p message-send-via-mail))
+ "Alist of ways to send outgoing messages.
+Each element has the form
+
+ \(TYPE PREDICATE FUNCTION)
+
+where TYPE is a symbol that names the method; PREDICATE is a function
+called without any parameters to determine whether the message is
+a message of type TYPE; and FUNCTION is a function to be called if
+PREDICATE returns non-nil. FUNCTION is called with one parameter --
+the prefix.")
+
+(defvar message-mail-alias-type 'abbrev
+ "*What alias expansion type to use in Message buffers.
+The default is `abbrev', which uses mailabbrev. nil switches
+mail aliases off.")
+
+;;; Internal variables.
+;;; Well, not really internal.
+
+(defvar message-mode-syntax-table
+ (let ((table (copy-syntax-table text-mode-syntax-table)))
+ (modify-syntax-entry ?% ". " table)
+ table)
+ "Syntax table used while in Message mode.")
+
+(defvar message-mode-abbrev-table text-mode-abbrev-table
+ "Abbrev table used in Message mode buffers.
+Defaults to `text-mode-abbrev-table'.")
+(defgroup message-headers nil
+ "Message headers."
+ :link '(custom-manual "(message)Variables")
+ :group 'message)
+
+(defface message-header-to-face
+ '((((class color)
+ (background dark))
+ (:foreground "green2" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "MidnightBlue" :bold t))
+ (t
+ (:bold t :italic t)))
+ "Face used for displaying From headers."
+ :group 'message-faces)
+
+(defface message-header-cc-face
+ '((((class color)
+ (background dark))
+ (:foreground "green4" :bold t))
+ (((class color)
+ (background light))
+ (:foreground "MidnightBlue"))
+ (t
+ (:bold t)))
+ "Face used for displaying Cc headers."
+ :group 'message-faces)
+
+(defface message-header-subject-face
+ '((((class color)
+ (background dark))
+ (:foreground "green3"))
+ (((class color)
+ (background light))
+ (:foreground "navy blue" :bold t))
+ (t
+ (:bold t)))
+ "Face used for displaying subject headers."
+ :group 'message-faces)
+
+(defface message-header-newsgroups-face
+ '((((class color)
+ (background dark))
+ (:foreground "yellow" :bold t :italic t))
+ (((class color)
+ (background light))
+ (:foreground "blue4" :bold t :italic t))
+ (t
+ (:bold t :italic t)))
+ "Face used for displaying newsgroups headers."
+ :group 'message-faces)
+
+(defface message-header-other-face
+ '((((class color)
+ (background dark))
+ (:foreground "red4"))
+ (((class color)
+ (background light))
+ (:foreground "steel blue"))
+ (t
+ (:bold t :italic t)))
+ "Face used for displaying newsgroups headers."
+ :group 'message-faces)
+
+(defface message-header-name-face
+ '((((class color)
+ (background dark))
+ (:foreground "DarkGreen"))
+ (((class color)
+ (background light))
+ (:foreground "cornflower blue"))
+ (t
+ (:bold t)))
+ "Face used for displaying header names."
+ :group 'message-faces)
+
+(defface message-header-xheader-face
+ '((((class color)
+ (background dark))
+ (:foreground "blue"))
+ (((class color)
+ (background light))
+ (:foreground "blue"))
+ (t
+ (:bold t)))
+ "Face used for displaying X-Header headers."
+ :group 'message-faces)
+
+(defface message-separator-face
+ '((((class color)
+ (background dark))
+ (:foreground "blue4"))
+ (((class color)
+ (background light))
+ (:foreground "brown"))
+ (t
+ (:bold t)))
+ "Face used for displaying the separator."
+ :group 'message-faces)
+
+(defface message-cited-text-face
+ '((((class color)
+ (background dark))
+ (:foreground "red"))
+ (((class color)
+ (background light))
+ (:foreground "red"))
+ (t
+ (:bold t)))
+ "Face used for displaying cited text names."
+ :group 'message-faces)
+
+(defvar message-font-lock-keywords
+ (let* ((cite-prefix "A-Za-z")
+ (cite-suffix (concat cite-prefix "0-9_.@-"))
+ (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
+ `((,(concat "^\\([Tt]o:\\)" content)
+ (1 'message-header-name-face)
+ (2 'message-header-to-face nil t))
+ (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
+ (1 'message-header-name-face)
+ (2 'message-header-cc-face nil t))
+ (,(concat "^\\([Ss]ubject:\\)" content)
+ (1 'message-header-name-face)
+ (2 'message-header-subject-face nil t))
+ (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
+ (1 'message-header-name-face)
+ (2 'message-header-newsgroups-face nil t))
+ (,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
+ (1 'message-header-name-face)
+ (2 'message-header-other-face nil t))
+ (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content)
+ (1 'message-header-name-face)
+ (2 'message-header-name-face))
+ (,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
+ 1 'message-separator-face)
+ (,(concat "^[ \t]*"
+ "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
+ "[>|}].*")
+ (0 'message-cited-text-face))))
+ "Additional expressions to highlight in Message mode.")
+
+(defvar message-face-alist
+ '((bold . bold-region)
+ (underline . underline-region)
+ (default . (lambda (b e)
+ (unbold-region b e)
+ (ununderline-region b e))))
+ "Alist of mail and news faces for facemenu.
+The cdr of ech entry is a function for applying the face to a region.")
+
+(defcustom message-send-hook nil
+ "Hook run before sending messages."
+ :group 'message-various
+ :options '(ispell-message)
+ :type 'hook)
+
+(defcustom message-send-mail-hook nil
+ "Hook run before sending mail messages."
+ :group 'message-various
+ :type 'hook)
+
+(defcustom message-send-news-hook nil
+ "Hook run before sending news messages."
+ :group 'message-various
+ :type 'hook)
+
+(defcustom message-sent-hook nil
+ "Hook run after sending messages."
+ :group 'message-various
+ :type 'hook)
+
+;;; Internal variables.
+
+(defvar message-buffer-list nil)
+(defvar message-this-is-news nil)
+(defvar message-this-is-mail nil)
+(defvar message-draft-article nil)
+
+;; Byte-compiler warning
+(defvar gnus-active-hashtb)
+(defvar gnus-read-active-file)
+
+;;; Regexp matching the delimiter of messages in UNIX mail format
+;;; (UNIX From lines), minus the initial ^. It should be a copy
+;;; of rmail.el's rmail-unix-mail-delimiter.
+(defvar message-unix-mail-delimiter
+ (let ((time-zone-regexp
+ (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
+ "\\|[-+]?[0-9][0-9][0-9][0-9]"
+ "\\|"
+ "\\) *")))
+ (concat
+ "From "
+
+ ;; Many things can happen to an RFC 822 mailbox before it is put into
+ ;; a `From' line. The leading phrase can be stripped, e.g.
+ ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g.
+ ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF
+ ;; can be removed, e.g.
+ ;; From: joe@y.z (Joe K
+ ;; User)
+ ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and
+ ;; From: Joe User
+ ;; <joe@y.z>
+ ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
+ ;; The mailbox can be removed or be replaced by white space, e.g.
+ ;; From: "Joe User"{space}{tab}
+ ;; <joe@y.z>
+ ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996',
+ ;; where {space} and {tab} represent the Ascii space and tab characters.
+ ;; We want to match the results of any of these manglings.
+ ;; The following regexp rejects names whose first characters are
+ ;; obviously bogus, but after that anything goes.
+ "\\([^\0-\b\n-\r\^?].*\\)? "
+
+ ;; The time the message was sent.
+ "\\([^\0-\r \^?]+\\) +" ; day of the week
+ "\\([^\0-\r \^?]+\\) +" ; month
+ "\\([0-3]?[0-9]\\) +" ; day of month
+ "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
+
+ ;; Perhaps a time zone, specified by an abbreviation, or by a
+ ;; numeric offset.
+ time-zone-regexp
+
+ ;; The year.
+ " \\([0-9][0-9]+\\) *"
+
+ ;; On some systems the time zone can appear after the year, too.
+ time-zone-regexp
+
+ ;; Old uucp cruft.
+ "\\(remote from .*\\)?"
+
+ "\n"))
+ "Regexp matching the delimiter of messages in UNIX mail format.")
+
+(defvar message-unsent-separator
+ (concat "^ *---+ +Unsent message follows +---+ *$\\|"
+ "^ *---+ +Returned message +---+ *$\\|"
+ "^Start of returned message$\\|"
+ "^ *---+ +Original message +---+ *$\\|"
+ "^ *--+ +begin message +--+ *$\\|"
+ "^ *---+ +Original message follows +---+ *$\\|"
+ "^|? *---+ +Message text follows: +---+ *|?$")
+ "A regexp that matches the separator before the text of a failed message.")
+
+(defvar message-header-format-alist
+ `((Newsgroups)
+ (To . message-fill-address)
+ (Cc . message-fill-address)
+ (Subject)
+ (In-Reply-To)
+ (Fcc)
+ (Bcc)
+ (Date)
+ (Organization)
+ (Distribution)
+ (Lines)
+ (Expires)
+ (Message-ID)
+ (References)
+ (X-Mailer)
+ (X-Newsreader))
+ "Alist used for formatting headers.")
+
+(eval-and-compile
+ (autoload 'message-setup-toolbar "messagexmas")
+ (autoload 'mh-send-letter "mh-comp")
+ (autoload 'gnus-point-at-eol "gnus-util")
+ (autoload 'gnus-point-at-bol "gnus-util")
+ (autoload 'gnus-output-to-mail "gnus-util")
+ (autoload 'gnus-output-to-rmail "gnus-util")
+ (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
+ (autoload 'nndraft-request-associate-buffer "nndraft")
+ (autoload 'nndraft-request-expire-articles "nndraft"))
+
+\f
+
+;;;
+;;; Utility functions.
+;;;
+
+(defmacro message-y-or-n-p (question show &rest text)
+ "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
+ `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
+
+;; Delete the current line (and the next N lines.);
+(defmacro message-delete-line (&optional n)
+ `(delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line ,(or n 1)) (point))))
+
+(defun message-tokenize-header (header &optional separator)
+ "Split HEADER into a list of header elements.
+\",\" is used as the separator."
+ (if (not header)
+ nil
+ (let ((regexp (format "[%s]+" (or separator ",")))
+ (beg 1)
+ (first t)
+ quoted elems paren)
+ (save-excursion
+ (message-set-work-buffer)
+ (insert header)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if first
+ (setq first nil)
+ (forward-char 1))
+ (cond ((and (> (point) beg)
+ (or (eobp)
+ (and (looking-at regexp)
+ (not quoted)
+ (not paren))))
+ (push (buffer-substring beg (point)) elems)
+ (setq beg (match-end 0)))
+ ((= (following-char) ?\")
+ (setq quoted (not quoted)))
+ ((and (= (following-char) ?\()
+ (not quoted))
+ (setq paren t))
+ ((and (= (following-char) ?\))
+ (not quoted))
+ (setq paren nil))))
+ (nreverse elems)))))
+
+(defun message-mail-file-mbox-p (file)
+ "Say whether FILE looks like a Unix mbox file."
+ (when (and (file-exists-p file)
+ (file-readable-p file)
+ (file-regular-p file))
+ (nnheader-temp-write nil
+ (nnheader-insert-file-contents file)
+ (goto-char (point-min))
+ (looking-at message-unix-mail-delimiter))))
+
+(defun message-fetch-field (header &optional not-all)
+ "The same as `mail-fetch-field', only remove all newlines."
+ (let ((value (mail-fetch-field header nil (not not-all))))
+ (when value
+ (nnheader-replace-chars-in-string value ?\n ? ))))
+
+(defun message-add-header (&rest headers)
+ "Add the HEADERS to the message header, skipping those already present."
+ (while headers
+ (let (hclean)
+ (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers))
+ (error "Invalid header `%s'" (car headers)))
+ (setq hclean (match-string 1 (car headers)))
+ (save-restriction
+ (message-narrow-to-headers)
+ (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
+ (insert (car headers) ?\n))))
+ (setq headers (cdr headers))))
+
+(defun message-fetch-reply-field (header)
+ "Fetch FIELD from the message we're replying to."
+ (when (and message-reply-buffer
+ (buffer-name message-reply-buffer))
+ (save-excursion
+ (set-buffer message-reply-buffer)
+ (message-fetch-field header))))
+
+(defun message-set-work-buffer ()
+ (if (get-buffer " *message work*")
+ (progn
+ (set-buffer " *message work*")
+ (erase-buffer))
+ (set-buffer (get-buffer-create " *message work*"))
+ (kill-all-local-variables)
+ (buffer-disable-undo (current-buffer))))
+
+(defun message-functionp (form)
+ "Return non-nil if FORM is funcallable."
+ (or (and (symbolp form) (fboundp form))
+ (and (listp form) (eq (car form) 'lambda))
+ (byte-code-function-p form)))
+
+(defun message-strip-subject-re (subject)
+ "Remove \"Re:\" from subject lines."
+ (if (string-match "^[Rr][Ee]: *" subject)
+ (substring subject (match-end 0))
+ subject))
+
+(defun message-remove-header (header &optional is-regexp first reverse)
+ "Remove HEADER in the narrowed buffer.
+If REGEXP, HEADER is a regular expression.
+If FIRST, only remove the first instance of the header.
+Return the number of headers removed."
+ (goto-char (point-min))
+ (let ((regexp (if is-regexp header (concat "^" header ":")))
+ (number 0)
+ (case-fold-search t)
+ last)
+ (while (and (not (eobp))
+ (not last))
+ (if (if reverse
+ (not (looking-at regexp))
+ (looking-at regexp))
+ (progn
+ (incf number)
+ (when first
+ (setq last t))
+ (delete-region
+ (point)
+ ;; There might be a continuation header, so we have to search
+ ;; until we find a new non-continuation line.
+ (progn
+ (forward-line 1)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (goto-char (match-beginning 0))
+ (point-max)))))
+ (forward-line 1)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (goto-char (match-beginning 0))
+ (point-max))))
+ number))
+
+(defun message-narrow-to-headers ()
+ "Narrow the buffer to the head of the message."
+ (widen)
+ (narrow-to-region
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+ (match-beginning 0)
+ (point-max)))
+ (goto-char (point-min)))
+
+(defun message-narrow-to-head ()
+ "Narrow the buffer to the head of the message."
+ (widen)
+ (narrow-to-region
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil 1)
+ (1- (point))
+ (point-max)))
+ (goto-char (point-min)))
+
+(defun message-news-p ()
+ "Say whether the current buffer contains a news message."
+ (or message-this-is-news
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-fetch-field "newsgroups")))))
+
+(defun message-mail-p ()
+ "Say whether the current buffer contains a mail message."
+ (or message-this-is-mail
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (or (message-fetch-field "to")
+ (message-fetch-field "cc")
+ (message-fetch-field "bcc"))))))
+
+(defun message-next-header ()
+ "Go to the beginning of the next header."
+ (beginning-of-line)
+ (or (eobp) (forward-char 1))
+ (not (if (re-search-forward "^[^ \t]" nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))))
+
+(defun message-sort-headers-1 ()
+ "Sort the buffer as headers using `message-rank' text props."
+ (goto-char (point-min))
+ (sort-subr
+ nil 'message-next-header
+ (lambda ()
+ (message-next-header)
+ (unless (bobp)
+ (forward-char -1)))
+ (lambda ()
+ (or (get-text-property (point) 'message-rank)
+ 10000))))
+
+(defun message-sort-headers ()
+ "Sort the headers of the current message according to `message-header-format-alist'."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (let ((max (1+ (length message-header-format-alist)))
+ rank)
+ (message-narrow-to-headers)
+ (while (re-search-forward "^[^ \n]+:" nil t)
+ (put-text-property
+ (match-beginning 0) (1+ (match-beginning 0))
+ 'message-rank
+ (if (setq rank (length (memq (assq (intern (buffer-substring
+ (match-beginning 0)
+ (1- (match-end 0))))
+ message-header-format-alist)
+ message-header-format-alist)))
+ (- max rank)
+ (1+ max)))))
+ (message-sort-headers-1))))
+
+\f
+
+;;;
+;;; Message mode
+;;;
+
+;;; Set up keymap.
+
+(defvar message-mode-map nil)
+
+(unless message-mode-map
+ (setq message-mode-map (copy-keymap text-mode-map))
+ (define-key message-mode-map "\C-c?" 'describe-mode)
+
+ (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
+ (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
+ (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
+ (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
+ (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
+ (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
+ (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
+ (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
+ (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
+ (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
+ (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
+ (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
+ (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
+
+ (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
+ (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
+
+ (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
+ (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
+ (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
+ (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
+ (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
+ (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
+
+ (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
+ (define-key message-mode-map "\C-c\C-s" 'message-send)
+ (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
+ (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
+
+ (define-key message-mode-map "\C-c\C-e" 'message-elide-region)
+ (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
+ (define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
+
+ (define-key message-mode-map "\t" 'message-tab))
+
+(easy-menu-define
+ message-mode-menu message-mode-map "Message Menu."
+ '("Message"
+ ["Sort Headers" message-sort-headers t]
+ ["Yank Original" message-yank-original t]
+ ["Fill Yanked Message" message-fill-yanked-message t]
+ ["Insert Signature" message-insert-signature t]
+ ["Caesar (rot13) Message" message-caesar-buffer-body t]
+ ["Caesar (rot13) Region" message-caesar-region (mark t)]
+ ["Elide Region" message-elide-region (mark t)]
+ ["Delete Outside Region" message-delete-not-region (mark t)]
+ ["Newline and Reformat" message-newline-and-reformat t]
+ ["Rename buffer" message-rename-buffer t]
+ ["Spellcheck" ispell-message t]
+ "----"
+ ["Send Message" message-send-and-exit t]
+ ["Abort Message" message-dont-send t]))
+
+(easy-menu-define
+ message-mode-field-menu message-mode-map ""
+ '("Field"
+ ["Fetch To" message-insert-to t]
+ ["Fetch Newsgroups" message-insert-newsgroups t]
+ "----"
+ ["To" message-goto-to t]
+ ["Subject" message-goto-subject t]
+ ["Cc" message-goto-cc t]
+ ["Reply-To" message-goto-reply-to t]
+ ["Summary" message-goto-summary t]
+ ["Keywords" message-goto-keywords t]
+ ["Newsgroups" message-goto-newsgroups t]
+ ["Followup-To" message-goto-followup-to t]
+ ["Distribution" message-goto-distribution t]
+ ["Body" message-goto-body t]
+ ["Signature" message-goto-signature t]))
+
+(defvar facemenu-add-face-function)
+(defvar facemenu-remove-face-function)
+
+;;;###autoload
+(defun message-mode ()
+ "Major mode for editing mail and news to be sent.
+Like Text Mode but with these additional commands:
+C-c C-s message-send (send the message) C-c C-c message-send-and-exit
+C-c C-f move to a header field (and create it if there isn't):
+ C-c C-f C-t move to To C-c C-f C-s move to Subject
+ C-c C-f C-c move to Cc C-c C-f C-b move to Bcc
+ C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To
+ C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups
+ C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution
+ C-c C-f C-f move to Followup-To
+C-c C-t message-insert-to (add a To header to a news followup)
+C-c C-n message-insert-newsgroups (add a Newsgroup header to a news reply)
+C-c C-b message-goto-body (move to beginning of message text).
+C-c C-i message-goto-signature (move to the beginning of the signature).
+C-c C-w message-insert-signature (insert `message-signature-file' file).
+C-c C-y message-yank-original (insert current message, if any).
+C-c C-q message-fill-yanked-message (fill what was yanked).
+C-c C-e message-elide-region (elide the text between point and mark).
+C-c C-r message-caesar-buffer-body (rot13 the message body)."
+ (interactive)
+ (kill-all-local-variables)
+ (make-local-variable 'message-reply-buffer)
+ (setq message-reply-buffer nil)
+ (make-local-variable 'message-send-actions)
+ (make-local-variable 'message-exit-actions)
+ (make-local-variable 'message-kill-actions)
+ (make-local-variable 'message-postpone-actions)
+ (make-local-variable 'message-draft-article)
+ (make-local-hook 'kill-buffer-hook)
+ (set-syntax-table message-mode-syntax-table)
+ (use-local-map message-mode-map)
+ (setq local-abbrev-table message-mode-abbrev-table)
+ (setq major-mode 'message-mode)
+ (setq mode-name "Message")
+ (setq buffer-offer-save t)
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults '(message-font-lock-keywords t))
+ (make-local-variable 'facemenu-add-face-function)
+ (make-local-variable 'facemenu-remove-face-function)
+ (setq facemenu-add-face-function
+ (lambda (face end)
+ (let ((face-fun (cdr (assq face message-face-alist))))
+ (if face-fun
+ (funcall face-fun (point) end)
+ (error "Face %s not configured for %s mode" face mode-name)))
+ "")
+ facemenu-remove-face-function t)
+ (make-local-variable 'paragraph-separate)
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start (concat (regexp-quote mail-header-separator)
+ "$\\|[ \t]*[-_][-_][-_]+$\\|"
+ "-- $\\|"
+ "[> ]+$\\|"
+ paragraph-start))
+ (setq paragraph-separate (concat (regexp-quote mail-header-separator)
+ "$\\|[ \t]*[-_][-_][-_]+$\\|"
+ "-- $\\|"
+ "[> ]+$\\|"
+ paragraph-separate))
+ (make-local-variable 'message-reply-headers)
+ (setq message-reply-headers nil)
+ (make-local-variable 'message-newsreader)
+ (make-local-variable 'message-mailer)
+ (make-local-variable 'message-post-method)
+ (make-local-variable 'message-sent-message-via)
+ (setq message-sent-message-via nil)
+ (make-local-variable 'message-checksum)
+ (setq message-checksum nil)
+ ;;(when (fboundp 'mail-hist-define-keys)
+ ;; (mail-hist-define-keys))
+ (when (string-match "XEmacs\\|Lucid" emacs-version)
+ (message-setup-toolbar))
+ (easy-menu-add message-mode-menu message-mode-map)
+ (easy-menu-add message-mode-field-menu message-mode-map)
+ ;; Allow mail alias things.
+ (when (eq message-mail-alias-type 'abbrev)
+ (if (fboundp 'mail-abbrevs-setup)
+ (mail-abbrevs-setup)
+ (funcall (intern "mail-aliases-setup"))))
+ (message-set-auto-save-file-name)
+ (run-hooks 'text-mode-hook 'message-mode-hook))
+
+\f
+
+;;;
+;;; Message mode commands
+;;;
+
+;;; Movement commands
+
+(defun message-goto-to ()
+ "Move point to the To header."
+ (interactive)
+ (message-position-on-field "To"))
+
+(defun message-goto-subject ()
+ "Move point to the Subject header."
+ (interactive)
+ (message-position-on-field "Subject"))
+
+(defun message-goto-cc ()
+ "Move point to the Cc header."
+ (interactive)
+ (message-position-on-field "Cc" "To"))
+
+(defun message-goto-bcc ()
+ "Move point to the Bcc header."
+ (interactive)
+ (message-position-on-field "Bcc" "Cc" "To"))
+
+(defun message-goto-fcc ()
+ "Move point to the Fcc header."
+ (interactive)
+ (message-position-on-field "Fcc" "To" "Newsgroups"))
+
+(defun message-goto-reply-to ()
+ "Move point to the Reply-To header."
+ (interactive)
+ (message-position-on-field "Reply-To" "Subject"))
+
+(defun message-goto-newsgroups ()
+ "Move point to the Newsgroups header."
+ (interactive)
+ (message-position-on-field "Newsgroups"))
+
+(defun message-goto-distribution ()
+ "Move point to the Distribution header."
+ (interactive)
+ (message-position-on-field "Distribution"))
+
+(defun message-goto-followup-to ()
+ "Move point to the Followup-To header."
+ (interactive)
+ (message-position-on-field "Followup-To" "Newsgroups"))
+
+(defun message-goto-keywords ()
+ "Move point to the Keywords header."
+ (interactive)
+ (message-position-on-field "Keywords" "Subject"))
+
+(defun message-goto-summary ()
+ "Move point to the Summary header."
+ (interactive)
+ (message-position-on-field "Summary" "Subject"))
+
+(defun message-goto-body ()
+ "Move point to the beginning of the message body."
+ (interactive)
+ (if (looking-at "[ \t]*\n") (expand-abbrev))
+ (goto-char (point-min))
+ (search-forward (concat "\n" mail-header-separator "\n") nil t))
+
+(defun message-goto-signature ()
+ "Move point to the beginning of the message signature."
+ (interactive)
+ (goto-char (point-min))
+ (if (re-search-forward message-signature-separator nil t)
+ (forward-line 1)
+ (goto-char (point-max))))
+
+\f
+
+(defun message-insert-to (&optional force)
+ "Insert a To header that points to the author of the article being replied to.
+If the original author requested not to be sent mail, the function signals
+an error.
+With the prefix argument FORCE, insert the header anyway."
+ (interactive "P")
+ (let ((co (message-fetch-reply-field "mail-copies-to")))
+ (when (and (null force)
+ co
+ (equal (downcase co) "never"))
+ (error "The user has requested not to have copies sent via mail")))
+ (when (and (message-position-on-field "To")
+ (mail-fetch-field "to")
+ (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
+ (insert ", "))
+ (insert (or (message-fetch-reply-field "reply-to")
+ (message-fetch-reply-field "from") "")))
+
+(defun message-insert-newsgroups ()
+ "Insert the Newsgroups header from the article being replied to."
+ (interactive)
+ (when (and (message-position-on-field "Newsgroups")
+ (mail-fetch-field "newsgroups")
+ (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
+ (insert ","))
+ (insert (or (message-fetch-reply-field "newsgroups") "")))
+
+\f
+
+;;; Various commands
+
+(defun message-delete-not-region (beg end)
+ "Delete everything in the body of the current message that is outside of the region."
+ (interactive "r")
+ (save-excursion
+ (goto-char end)
+ (delete-region (point) (progn (message-goto-signature)
+ (forward-line -2)
+ (point)))
+ (insert "\n")
+ (goto-char beg)
+ (delete-region beg (progn (message-goto-body)
+ (forward-line 2)
+ (point))))
+ (message-goto-signature)
+ (forward-line -2))
+
+(defun message-newline-and-reformat ()
+ "Insert four newlines, and then reformat if inside quoted text."
+ (interactive)
+ (let ((point (point))
+ quoted)
+ (save-excursion
+ (beginning-of-line)
+ (setq quoted (looking-at (regexp-quote message-yank-prefix))))
+ (insert "\n\n\n\n")
+ (when quoted
+ (insert message-yank-prefix))
+ (fill-paragraph nil)
+ (goto-char point)
+ (forward-line 2)))
+
+(defun message-insert-signature (&optional force)
+ "Insert a signature. See documentation for the `message-signature' variable."
+ (interactive (list 0))
+ (let* ((signature
+ (cond
+ ((and (null message-signature)
+ (eq force 0))
+ (save-excursion
+ (goto-char (point-max))
+ (not (re-search-backward
+ message-signature-separator nil t))))
+ ((and (null message-signature)
+ force)
+ t)
+ ((message-functionp message-signature)
+ (funcall message-signature))
+ ((listp message-signature)
+ (eval message-signature))
+ (t message-signature)))
+ (signature
+ (cond ((stringp signature)
+ signature)
+ ((and (eq t signature)
+ message-signature-file
+ (file-exists-p message-signature-file))
+ signature))))
+ (when signature
+ (goto-char (point-max))
+ ;; Insert the signature.
+ (unless (bolp)
+ (insert "\n"))
+ (insert "\n-- \n")
+ (if (eq signature t)
+ (insert-file-contents message-signature-file)
+ (insert signature))
+ (goto-char (point-max))
+ (or (bolp) (insert "\n")))))
+
+(defun message-elide-region (b e)
+ "Elide the text between point and mark. An ellipsis (from
+message-elide-elipsis) will be inserted where the text was killed."
+ (interactive "r")
+ (kill-region b e)
+ (unless (bolp)
+ (insert "\n"))
+ (insert message-elide-elipsis))
+
+(defvar message-caesar-translation-table nil)
+
+(defun message-caesar-region (b e &optional n)
+ "Caesar rotation of region by N, default 13, for decrypting netnews."
+ (interactive
+ (list
+ (min (point) (or (mark t) (point)))
+ (max (point) (or (mark t) (point)))
+ (when current-prefix-arg
+ (prefix-numeric-value current-prefix-arg))))
+
+ (setq n (if (numberp n) (mod n 26) 13)) ;canonize N
+ (unless (or (zerop n) ; no action needed for a rot of 0
+ (= b e)) ; no region to rotate
+ ;; We build the table, if necessary.
+ (when (or (not message-caesar-translation-table)
+ (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
+ (setq message-caesar-translation-table
+ (message-make-caesar-translation-table n)))
+ ;; Then we translate the region. Do it this way to retain
+ ;; text properties.
+ (while (< b e)
+ (subst-char-in-region
+ b (1+ b) (char-after b)
+ (aref message-caesar-translation-table (char-after b)))
+ (incf b))))
+
+(defun message-make-caesar-translation-table (n)
+ "Create a rot table with offset N."
+ (let ((i -1)
+ (table (make-string 256 0)))
+ (while (< (incf i) 256)
+ (aset table i i))
+ (concat
+ (substring table 0 ?A)
+ (substring table (+ ?A n) (+ ?A n (- 26 n)))
+ (substring table ?A (+ ?A n))
+ (substring table (+ ?A 26) ?a)
+ (substring table (+ ?a n) (+ ?a n (- 26 n)))
+ (substring table ?a (+ ?a n))
+ (substring table (+ ?a 26) 255))))
+
+(defun message-caesar-buffer-body (&optional rotnum)
+ "Caesar rotates all letters in the current buffer by 13 places.
+Used to encode/decode possibly offensive messages (commonly in net.jokes).
+With prefix arg, specifies the number of places to rotate each letter forward.
+Mail and USENET news headers are not rotated."
+ (interactive (if current-prefix-arg
+ (list (prefix-numeric-value current-prefix-arg))
+ (list nil)))
+ (save-excursion
+ (save-restriction
+ (when (message-goto-body)
+ (narrow-to-region (point) (point-max)))
+ (message-caesar-region (point-min) (point-max) rotnum))))
+
+(defun message-pipe-buffer-body (program)
+ "Pipe the message body in the current buffer through PROGRAM."
+ (save-excursion
+ (save-restriction
+ (when (message-goto-body)
+ (narrow-to-region (point) (point-max)))
+ (let ((body (buffer-substring (point-min) (point-max))))
+ (unless (equal 0 (call-process-region
+ (point-min) (point-max) program t t))
+ (insert body)
+ (message "%s failed." program))))))
+
+(defun message-rename-buffer (&optional enter-string)
+ "Rename the *message* buffer to \"*message* RECIPIENT\".
+If the function is run with a prefix, it will ask for a new buffer
+name, rather than giving an automatic name."
+ (interactive "Pbuffer name: ")
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (narrow-to-region (point)
+ (search-forward mail-header-separator nil 'end))
+ (let* ((mail-to (or
+ (if (message-news-p) (message-fetch-field "Newsgroups")
+ (message-fetch-field "To"))
+ ""))
+ (mail-trimmed-to
+ (if (string-match "," mail-to)
+ (concat (substring mail-to 0 (match-beginning 0)) ", ...")
+ mail-to))
+ (name-default (concat "*message* " mail-trimmed-to))
+ (name (if enter-string
+ (read-string "New buffer name: " name-default)
+ name-default))
+ (default-directory
+ (file-name-as-directory message-autosave-directory)))
+ (rename-buffer name t)))))
+
+(defun message-fill-yanked-message (&optional justifyp)
+ "Fill the paragraphs of a message yanked into this one.
+Numeric argument means justify as well."
+ (interactive "P")
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward (concat "\n" mail-header-separator "\n") nil t)
+ (let ((fill-prefix message-yank-prefix))
+ (fill-individual-paragraphs (point) (point-max) justifyp t))))
+
+(defun message-indent-citation ()
+ "Modify text just inserted from a message to be cited.
+The inserted text should be the region.
+When this function returns, the region is again around the modified text.
+
+Normally, indent each nonblank line `message-indentation-spaces' spaces.
+However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
+ (let ((start (point)))
+ ;; Remove unwanted headers.
+ (when message-ignored-cited-headers
+ (let (all-removed)
+ (save-restriction
+ (narrow-to-region
+ (goto-char start)
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point)))
+ (message-remove-header message-ignored-cited-headers t)
+ (when (= (point-min) (point-max))
+ (setq all-removed t))
+ (goto-char (point-max)))
+ (if all-removed
+ (goto-char start)
+ (forward-line 1))))
+ ;; Delete blank lines at the start of the buffer.
+ (while (and (point-min)
+ (eolp)
+ (not (eobp)))
+ (message-delete-line))
+ ;; Delete blank lines at the end of the buffer.
+ (goto-char (point-max))
+ (unless (eolp)
+ (insert "\n"))
+ (while (and (zerop (forward-line -1))
+ (looking-at "$"))
+ (message-delete-line))
+ ;; Do the indentation.
+ (if (null message-yank-prefix)
+ (indent-rigidly start (mark t) message-indentation-spaces)
+ (save-excursion
+ (goto-char start)
+ (while (< (point) (mark t))
+ (insert message-yank-prefix)
+ (forward-line 1))))
+ (goto-char start)))
+
+(defun message-yank-original (&optional arg)
+ "Insert the message being replied to, if any.
+Puts point before the text and mark after.
+Normally indents each nonblank line ARG spaces (default 3). However,
+if `message-yank-prefix' is non-nil, insert that prefix on each line.
+
+This function uses `message-cite-function' to do the actual citing.
+
+Just \\[universal-argument] as argument means don't indent, insert no
+prefix, and don't delete any headers."
+ (interactive "P")
+ (let ((modified (buffer-modified-p)))
+ (when (and message-reply-buffer
+ message-cite-function)
+ (delete-windows-on message-reply-buffer t)
+ (insert-buffer message-reply-buffer)
+ (funcall message-cite-function)
+ (message-exchange-point-and-mark)
+ (unless (bolp)
+ (insert ?\n))
+ (unless modified
+ (setq message-checksum (cons (message-checksum) (buffer-size)))))))
+
+(defun message-cite-original ()
+ "Cite function in the standard Message manner."
+ (let ((start (point))
+ (functions
+ (when message-indent-citation-function
+ (if (listp message-indent-citation-function)
+ message-indent-citation-function
+ (list message-indent-citation-function)))))
+ (goto-char start)
+ (while functions
+ (funcall (pop functions)))
+ (when message-citation-line-function
+ (unless (bolp)
+ (insert "\n"))
+ (funcall message-citation-line-function))))
+
+(defun message-insert-citation-line ()
+ "Function that inserts a simple citation line."
+ (when message-reply-headers
+ (insert (mail-header-from message-reply-headers) " writes:\n\n")))
+
+(defun message-position-on-field (header &rest afters)
+ (let ((case-fold-search t))
+ (save-restriction
+ (narrow-to-region
+ (goto-char (point-min))
+ (progn
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (match-beginning 0)))
+ (goto-char (point-min))
+ (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t)
+ (progn
+ (re-search-forward "^[^ \t]" nil 'move)
+ (beginning-of-line)
+ (skip-chars-backward "\n")
+ t)
+ (while (and afters
+ (not (re-search-forward
+ (concat "^" (regexp-quote (car afters)) ":")
+ nil t)))
+ (pop afters))
+ (when afters
+ (re-search-forward "^[^ \t]" nil 'move)
+ (beginning-of-line))
+ (insert header ": \n")
+ (forward-char -1)
+ nil))))
+
+(defun message-remove-signature ()
+ "Remove the signature from the text between point and mark.
+The text will also be indented the normal way."
+ (save-excursion
+ (let ((start (point))
+ mark)
+ (if (not (re-search-forward message-signature-separator (mark t) t))
+ ;; No signature here, so we just indent the cited text.
+ (message-indent-citation)
+ ;; Find the last non-empty line.
+ (forward-line -1)
+ (while (looking-at "[ \t]*$")
+ (forward-line -1))
+ (forward-line 1)
+ (setq mark (set-marker (make-marker) (point)))
+ (goto-char start)
+ (message-indent-citation)
+ ;; Enable undoing the deletion.
+ (undo-boundary)
+ (delete-region mark (mark t))
+ (set-marker mark nil)))))
+
+\f
+
+;;;
+;;; Sending messages
+;;;
+
+(defun message-send-and-exit (&optional arg)
+ "Send message like `message-send', then, if no errors, exit from mail buffer."
+ (interactive "P")
+ (let ((buf (current-buffer))
+ (actions message-exit-actions))
+ (when (and (message-send arg)
+ (buffer-name buf))
+ (if message-kill-buffer-on-exit
+ (kill-buffer buf)
+ (bury-buffer buf)
+ (when (eq buf (current-buffer))
+ (message-bury buf)))
+ (message-do-actions actions))))
+
+(defun message-dont-send ()
+ "Don't send the message you have been editing."
+ (interactive)
+ (let ((actions message-postpone-actions))
+ (message-bury (current-buffer))
+ (message-do-actions actions)))
+
+(defun message-kill-buffer ()
+ "Kill the current buffer."
+ (interactive)
+ (when (or (not (buffer-modified-p))
+ (yes-or-no-p "Message modified; kill anyway? "))
+ (let ((actions message-kill-actions))
+ (setq buffer-file-name nil)
+ (kill-buffer (current-buffer))
+ (message-do-actions actions))))
+
+(defun message-bury (buffer)
+ "Bury this mail buffer."
+ (let ((newbuf (other-buffer buffer)))
+ (bury-buffer buffer)
+ (if (and (fboundp 'frame-parameters)
+ (cdr (assq 'dedicated (frame-parameters)))
+ (not (null (delq (selected-frame) (visible-frame-list)))))
+ (delete-frame (selected-frame))
+ (switch-to-buffer newbuf))))
+
+(defun message-send (&optional arg)
+ "Send the message in the current buffer.
+If `message-interactive' is non-nil, wait for success indication
+or error messages, and inform user.
+Otherwise any failure is reported in a message back to
+the user from the mailer."
+ (interactive "P")
+ ;; Disabled test.
+ (when (if (and buffer-file-name
+ nil)
+ (y-or-n-p (format "Send buffer contents as %s message? "
+ (if (message-mail-p)
+ (if (message-news-p) "mail and news" "mail")
+ "news")))
+ (or (buffer-modified-p)
+ (message-check-element 'unchanged)
+ (y-or-n-p "No changes in the buffer; really send? ")))
+ ;; Make it possible to undo the coming changes.
+ (undo-boundary)
+ (let ((inhibit-read-only t))
+ (put-text-property (point-min) (point-max) 'read-only nil))
+ (message-fix-before-sending)
+ (run-hooks 'message-send-hook)
+ (message "Sending...")
+ (let ((alist message-send-method-alist)
+ (success t)
+ elem sent)
+ (while (and success
+ (setq elem (pop alist)))
+ (when (and (or (not (funcall (cadr elem)))
+ (and (or (not (memq (car elem)
+ message-sent-message-via))
+ (y-or-n-p
+ (format
+ "Already sent message via %s; resend? "
+ (car elem))))
+ (setq success (funcall (caddr elem) arg)))))
+ (setq sent t)))
+ (when (and success sent)
+ (message-do-fcc)
+ ;;(when (fboundp 'mail-hist-put-headers-into-history)
+ ;; (mail-hist-put-headers-into-history))
+ (run-hooks 'message-sent-hook)
+ (message "Sending...done")
+ ;; Mark the buffer as unmodified and delete autosave.
+ (set-buffer-modified-p nil)
+ (delete-auto-save-file-if-necessary t)
+ (message-disassociate-draft)
+ ;; Delete other mail buffers and stuff.
+ (message-do-send-housekeeping)
+ (message-do-actions message-send-actions)
+ ;; Return success.
+ t))))
+
+(defun message-send-via-mail (arg)
+ "Send the current message via mail."
+ (message-send-mail arg))
+
+(defun message-send-via-news (arg)
+ "Send the current message via news."
+ (funcall message-send-news-function arg))
+
+(defun message-fix-before-sending ()
+ "Do various things to make the message nice before sending it."
+ ;; Make sure there's a newline at the end of the message.
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n")))
+
+(defun message-add-action (action &rest types)
+ "Add ACTION to be performed when doing an exit of type TYPES."
+ (let (var)
+ (while types
+ (set (setq var (intern (format "message-%s-actions" (pop types))))
+ (nconc (symbol-value var) (list action))))))
+
+(defun message-do-actions (actions)
+ "Perform all actions in ACTIONS."
+ ;; Now perform actions on successful sending.
+ (while actions
+ (ignore-errors
+ (cond
+ ;; A simple function.
+ ((message-functionp (car actions))
+ (funcall (car actions)))
+ ;; Something to be evaled.
+ (t
+ (eval (car actions)))))
+ (pop actions)))
+
+(defun message-send-mail (&optional arg)
+ (require 'mail-utils)
+ (let ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
+ (case-fold-search nil)
+ (news (message-news-p))
+ (mailbuf (current-buffer)))
+ (save-restriction
+ (message-narrow-to-headers)
+ ;; Insert some headers.
+ (let ((message-deletable-headers
+ (if news nil message-deletable-headers)))
+ (message-generate-headers message-required-mail-headers))
+ ;; Let the user do all of the above.
+ (run-hooks 'message-header-hook))
+ (unwind-protect
+ (save-excursion
+ (set-buffer tembuf)
+ (erase-buffer)
+ ;; Avoid copying text props.
+ (insert (format
+ "%s" (save-excursion
+ (set-buffer mailbuf)
+ (buffer-string))))
+ ;; Remove some headers.
+ (save-restriction
+ (message-narrow-to-headers)
+ ;; Remove some headers.
+ (message-remove-header message-ignored-mail-headers t))
+ (goto-char (point-max))
+ ;; require one newline at the end.
+ (or (= (preceding-char) ?\n)
+ (insert ?\n))
+ (when (and news
+ (or (message-fetch-field "cc")
+ (message-fetch-field "to")))
+ (message-insert-courtesy-copy))
+ (funcall message-send-mail-function))
+ (kill-buffer tembuf))
+ (set-buffer mailbuf)
+ (push 'mail message-sent-message-via)))
+
+(defun message-send-mail-with-sendmail ()
+ "Send off the prepared buffer with sendmail."
+ (let ((errbuf (if message-interactive
+ (generate-new-buffer " sendmail errors")
+ 0))
+ resend-to-addresses delimline)
+ (let ((case-fold-search t))
+ (save-restriction
+ (message-narrow-to-headers)
+ (setq resend-to-addresses (message-fetch-field "resent-to")))
+ ;; Change header-delimiter to be what sendmail expects.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (backward-char 1)
+ (setq delimline (point-marker))
+ (run-hooks 'message-send-mail-hook)
+ ;; Insert an extra newline if we need it to work around
+ ;; Sun's bug that swallows newlines.
+ (goto-char (1+ delimline))
+ (when (eval message-mailer-swallows-blank-line)
+ (newline))
+ (when message-interactive
+ (save-excursion
+ (set-buffer errbuf)
+ (erase-buffer))))
+ (let ((default-directory "/"))
+ (apply 'call-process-region
+ (append (list (point-min) (point-max)
+ (if (boundp 'sendmail-program)
+ sendmail-program
+ "/usr/lib/sendmail")
+ nil errbuf nil "-oi")
+ ;; Always specify who from,
+ ;; since some systems have broken sendmails.
+ ;; But some systems are more broken with -f, so
+ ;; we'll let users override this.
+ (if (null message-sendmail-f-is-evil)
+ (list "-f" (user-login-name)))
+ ;; These mean "report errors by mail"
+ ;; and "deliver in background".
+ (if (null message-interactive) '("-oem" "-odb"))
+ ;; Get the addresses from the message
+ ;; unless this is a resend.
+ ;; We must not do that for a resend
+ ;; because we would find the original addresses.
+ ;; For a resend, include the specific addresses.
+ (if resend-to-addresses
+ (list resend-to-addresses)
+ '("-t")))))
+ (when message-interactive
+ (save-excursion
+ (set-buffer errbuf)
+ (goto-char (point-min))
+ (while (re-search-forward "\n\n* *" nil t)
+ (replace-match "; "))
+ (if (not (zerop (buffer-size)))
+ (error "Sending...failed to %s"
+ (buffer-substring (point-min) (point-max)))))
+ (when (bufferp errbuf)
+ (kill-buffer errbuf)))))
+
+(defun message-send-mail-with-qmail ()
+ "Pass the prepared message buffer to qmail-inject.
+Refer to the documentation for the variable `message-send-mail-function'
+to find out how to use this."
+ ;; replace the header delimiter with a blank line
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (run-hooks 'message-send-mail-hook)
+ ;; send the message
+ (case
+ (apply
+ 'call-process-region 1 (point-max) message-qmail-inject-program
+ nil nil nil
+ ;; qmail-inject's default behaviour is to look for addresses on the
+ ;; command line; if there're none, it scans the headers.
+ ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
+ ;;
+ ;; in general, ALL of qmail-inject's defaults are perfect for simply
+ ;; reading a formatted (i. e., at least a To: or Resent-To header)
+ ;; message from stdin.
+ ;;
+ ;; qmail also has the advantage of not having been raped by
+ ;; various vendors, so we don't have to allow for that, either --
+ ;; compare this with message-send-mail-with-sendmail and weep
+ ;; for sendmail's lost innocence.
+ ;;
+ ;; all this is way cool coz it lets us keep the arguments entirely
+ ;; free for -inject-arguments -- a big win for the user and for us
+ ;; since we don't have to play that double-guessing game and the user
+ ;; gets full control (no gestapo'ish -f's, for instance). --sj
+ message-qmail-inject-args)
+ ;; qmail-inject doesn't say anything on it's stdout/stderr,
+ ;; we have to look at the retval instead
+ (0 nil)
+ (1 (error "qmail-inject reported permanent failure"))
+ (111 (error "qmail-inject reported transient failure"))
+ ;; should never happen
+ (t (error "qmail-inject reported unknown failure"))))
+
+(defun message-send-mail-with-mh ()
+ "Send the prepared message buffer with mh."
+ (let ((mh-previous-window-config nil)
+ (name (make-temp-name
+ (concat (file-name-as-directory
+ (expand-file-name message-autosave-directory))
+ "msg."))))
+ (setq buffer-file-name name)
+ ;; MH wants to generate these headers itself.
+ (when message-mh-deletable-headers
+ (let ((headers message-mh-deletable-headers))
+ (while headers
+ (goto-char (point-min))
+ (and (re-search-forward
+ (concat "^" (symbol-name (car headers)) ": *") nil t)
+ (message-delete-line))
+ (pop headers))))
+ (run-hooks 'message-send-mail-hook)
+ ;; Pass it on to mh.
+ (mh-send-letter)))
+
+(defun message-send-news (&optional arg)
+ (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
+ (case-fold-search nil)
+ (method (if (message-functionp message-post-method)
+ (funcall message-post-method arg)
+ message-post-method))
+ (messbuf (current-buffer))
+ (message-syntax-checks
+ (if arg
+ (cons '(existing-newsgroups . disabled)
+ message-syntax-checks)
+ message-syntax-checks))
+ result)
+ (save-restriction
+ (message-narrow-to-headers)
+ ;; Insert some headers.
+ (message-generate-headers message-required-news-headers)
+ ;; Let the user do all of the above.
+ (run-hooks 'message-header-hook))
+ (message-cleanup-headers)
+ (if (not (message-check-news-syntax))
+ (progn
+ ;;(message "Posting not performed")
+ nil)
+ (unwind-protect
+ (save-excursion
+ (set-buffer tembuf)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ ;; Avoid copying text props.
+ (insert (format
+ "%s" (save-excursion
+ (set-buffer messbuf)
+ (buffer-string))))
+ ;; Remove some headers.
+ (save-restriction
+ (message-narrow-to-headers)
+ ;; Remove some headers.
+ (message-remove-header message-ignored-news-headers t))
+ (goto-char (point-max))
+ ;; require one newline at the end.
+ (or (= (preceding-char) ?\n)
+ (insert ?\n))
+ (let ((case-fold-search t))
+ ;; Remove the delimiter.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (backward-char 1))
+ (run-hooks 'message-send-news-hook)
+ ;;(require (car method))
+ ;;(funcall (intern (format "%s-open-server" (car method)))
+ ;;(cadr method) (cddr method))
+ ;;(setq result
+ ;; (funcall (intern (format "%s-request-post" (car method)))
+ ;; (cadr method)))
+ (gnus-open-server method)
+ (setq result (gnus-request-post method)))
+ (kill-buffer tembuf))
+ (set-buffer messbuf)
+ (if result
+ (push 'news message-sent-message-via)
+ (message "Couldn't send message via news: %s"
+ (nnheader-get-report (car method)))
+ nil))))
+
+;;;
+;;; Header generation & syntax checking.
+;;;
+
+(defmacro message-check (type &rest forms)
+ "Eval FORMS if TYPE is to be checked."
+ `(or (message-check-element ,type)
+ (save-excursion
+ ,@forms)))
+
+(put 'message-check 'lisp-indent-function 1)
+(put 'message-check 'edebug-form-spec '(form body))
+
+(defun message-check-element (type)
+ "Returns non-nil if this type is not to be checked."
+ (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
+ t
+ (let ((able (assq type message-syntax-checks)))
+ (and (consp able)
+ (eq (cdr able) 'disabled)))))
+
+(defun message-check-news-syntax ()
+ "Check the syntax of the message."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (and
+ ;; We narrow to the headers and check them first.
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-check-news-header-syntax)))
+ ;; Check the body.
+ (message-check-news-body-syntax)))))
+
+(defun message-check-news-header-syntax ()
+ (and
+ ;; Check the Subject header.
+ (message-check 'subject
+ (let* ((case-fold-search t)
+ (subject (message-fetch-field "subject")))
+ (or
+ (and subject
+ (not (string-match "\\`[ \t]*\\'" subject)))
+ (ignore
+ (message
+ "The subject field is empty or missing. Posting is denied.")))))
+ ;; Check for commands in Subject.
+ (message-check 'subject-cmsg
+ (if (string-match "^cmsg " (message-fetch-field "subject"))
+ (y-or-n-p
+ "The control code \"cmsg\" is in the subject. Really post? ")
+ t))
+ ;; Check for multiple identical headers.
+ (message-check 'multiple-headers
+ (let (found)
+ (while (and (not found)
+ (re-search-forward "^[^ \t:]+: " nil t))
+ (save-excursion
+ (or (re-search-forward
+ (concat "^"
+ (regexp-quote
+ (setq found
+ (buffer-substring
+ (match-beginning 0) (- (match-end 0) 2))))
+ ":")
+ nil t)
+ (setq found nil))))
+ (if found
+ (y-or-n-p (format "Multiple %s headers. Really post? " found))
+ t)))
+ ;; Check for Version and Sendsys.
+ (message-check 'sendsys
+ (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
+ (y-or-n-p
+ (format "The article contains a %s command. Really post? "
+ (buffer-substring (match-beginning 0)
+ (1- (match-end 0)))))
+ t))
+ ;; See whether we can shorten Followup-To.
+ (message-check 'shorten-followup-to
+ (let ((newsgroups (message-fetch-field "newsgroups"))
+ (followup-to (message-fetch-field "followup-to"))
+ to)
+ (when (and newsgroups
+ (string-match "," newsgroups)
+ (not followup-to)
+ (not
+ (zerop
+ (length
+ (setq to (completing-read
+ "Followups to: (default all groups) "
+ (mapcar (lambda (g) (list g))
+ (cons "poster"
+ (message-tokenize-header
+ newsgroups)))))))))
+ (goto-char (point-min))
+ (insert "Followup-To: " to "\n"))
+ t))
+ ;; Check "Shoot me".
+ (message-check 'shoot
+ (if (re-search-forward
+ "Message-ID.*.i-did-not-set--mail-host-address--so-shoot-me" nil t)
+ (y-or-n-p "You appear to have a misconfigured system. Really post? ")
+ t))
+ ;; Check for Approved.
+ (message-check 'approved
+ (if (re-search-forward "^Approved:" nil t)
+ (y-or-n-p "The article contains an Approved header. Really post? ")
+ t))
+ ;; Check the Message-ID header.
+ (message-check 'message-id
+ (let* ((case-fold-search t)
+ (message-id (message-fetch-field "message-id" t)))
+ (or (not message-id)
+ (and (string-match "@" message-id)
+ (string-match "@[^\\.]*\\." message-id))
+ (y-or-n-p
+ (format "The Message-ID looks strange: \"%s\". Really post? "
+ message-id)))))
+ ;; Check the Newsgroups & Followup-To headers.
+ (message-check 'existing-newsgroups
+ (let* ((case-fold-search t)
+ (newsgroups (message-fetch-field "newsgroups"))
+ (followup-to (message-fetch-field "followup-to"))
+ (groups (message-tokenize-header
+ (if followup-to
+ (concat newsgroups "," followup-to)
+ newsgroups)))
+ (hashtb (and (boundp 'gnus-active-hashtb)
+ gnus-active-hashtb))
+ errors)
+ (if (or (not hashtb)
+ (not (boundp 'gnus-read-active-file))
+ (not gnus-read-active-file)
+ (eq gnus-read-active-file 'some))
+ t
+ (while groups
+ (when (and (not (boundp (intern (car groups) hashtb)))
+ (not (equal (car groups) "poster")))
+ (push (car groups) errors))
+ (pop groups))
+ (if (not errors)
+ t
+ (y-or-n-p
+ (format
+ "Really post to %s unknown group%s: %s "
+ (if (= (length errors) 1) "this" "these")
+ (if (= (length errors) 1) "" "s")
+ (mapconcat 'identity errors ", ")))))))
+ ;; Check the Newsgroups & Followup-To headers for syntax errors.
+ (message-check 'valid-newsgroups
+ (let ((case-fold-search t)
+ (headers '("Newsgroups" "Followup-To"))
+ header error)
+ (while (and headers (not error))
+ (when (setq header (mail-fetch-field (car headers)))
+ (if (or
+ (not
+ (string-match
+ "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
+ header))
+ (memq
+ nil (mapcar
+ (lambda (g)
+ (not (string-match "\\.\\'\\|\\.\\." g)))
+ (message-tokenize-header header ","))))
+ (setq error t)))
+ (unless error
+ (pop headers)))
+ (if (not error)
+ t
+ (y-or-n-p
+ (format "The %s header looks odd: \"%s\". Really post? "
+ (car headers) header)))))
+ (message-check 'repeated-newsgroups
+ (let ((case-fold-search t)
+ (headers '("Newsgroups" "Followup-To"))
+ header error groups group)
+ (while (and headers
+ (not error))
+ (when (setq header (mail-fetch-field (pop headers)))
+ (setq groups (message-tokenize-header header ","))
+ (while (setq group (pop groups))
+ (when (member group groups)
+ (setq error group
+ groups nil)))))
+ (if (not error)
+ t
+ (y-or-n-p
+ (format "Group %s is repeated in headers. Really post? " error)))))
+ ;; Check the From header.
+ (message-check 'from
+ (let* ((case-fold-search t)
+ (from (message-fetch-field "from"))
+ (ad (nth 1 (mail-extract-address-components from))))
+ (cond
+ ((not from)
+ (message "There is no From line. Posting is denied.")
+ nil)
+ ((or (not (string-match "@[^\\.]*\\." ad)) ;larsi@ifi
+ (string-match "\\.\\." ad) ;larsi@ifi..uio
+ (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-match "\\.$" ad) ;larsi@ifi.uio.
+ (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
+ (string-match "(.*).*(.*)" from)) ;(lars) (lars)
+ (message
+ "Denied posting -- the From looks strange: \"%s\"." from)
+ nil)
+ (t t))))))
+
+(defun message-check-news-body-syntax ()
+ (and
+ ;; Check for long lines.
+ (message-check 'long-lines
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (while (and
+ (progn
+ (end-of-line)
+ (< (current-column) 80))
+ (zerop (forward-line 1))))
+ (or (bolp)
+ (eobp)
+ (y-or-n-p
+ "You have lines longer than 79 characters. Really post? ")))
+ ;; Check whether the article is empty.
+ (message-check 'empty
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
+ (let ((b (point)))
+ (goto-char (point-max))
+ (re-search-backward message-signature-separator nil t)
+ (beginning-of-line)
+ (or (re-search-backward "[^ \n\t]" b t)
+ (y-or-n-p "Empty article. Really post? "))))
+ ;; Check for control characters.
+ (message-check 'control-chars
+ (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
+ (y-or-n-p
+ "The article contains control characters. Really post? ")
+ t))
+ ;; Check excessive size.
+ (message-check 'size
+ (if (> (buffer-size) 60000)
+ (y-or-n-p
+ (format "The article is %d octets long. Really post? "
+ (buffer-size)))
+ t))
+ ;; Check whether any new text has been added.
+ (message-check 'new-text
+ (or
+ (not message-checksum)
+ (not (and (eq (message-checksum) (car message-checksum))
+ (eq (buffer-size) (cdr message-checksum))))
+ (y-or-n-p
+ "It looks like no new text has been added. Really post? ")))
+ ;; Check the length of the signature.
+ (message-check 'signature
+ (goto-char (point-max))
+ (if (or (not (re-search-backward message-signature-separator nil t))
+ (search-forward message-forward-end-separator nil t))
+ t
+ (if (> (count-lines (point) (point-max)) 5)
+ (y-or-n-p
+ (format
+ "Your .sig is %d lines; it should be max 4. Really post? "
+ (1- (count-lines (point) (point-max)))))
+ t)))))
+
+(defun message-checksum ()
+ "Return a \"checksum\" for the current buffer."
+ (let ((sum 0))
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (while (not (eobp))
+ (when (not (looking-at "[ \t\n]"))
+ (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1)
+ (following-char))))
+ (forward-char 1)))
+ sum))
+
+(defun message-do-fcc ()
+ "Process Fcc headers in the current buffer."
+ (let ((case-fold-search t)
+ (buf (current-buffer))
+ list file)
+ (save-excursion
+ (set-buffer (get-buffer-create " *message temp*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-buffer-substring buf)
+ (save-restriction
+ (message-narrow-to-headers)
+ (while (setq file (message-fetch-field "fcc"))
+ (push file list)
+ (message-remove-header "fcc" nil t)))
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+ (replace-match "" t t)
+ ;; Process FCC operations.
+ (while list
+ (setq file (pop list))
+ (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
+ ;; Pipe the article to the program in question.
+ (call-process-region (point-min) (point-max) shell-file-name
+ nil nil nil shell-command-switch
+ (match-string 1 file))
+ ;; Save the article.
+ (setq file (expand-file-name file))
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (if (and message-fcc-handler-function
+ (not (eq message-fcc-handler-function 'rmail-output)))
+ (funcall message-fcc-handler-function file)
+ (if (and (file-readable-p file) (mail-file-babyl-p file))
+ (rmail-output file 1 nil t)
+ (let ((mail-use-rfc822 t))
+ (rmail-output file 1 t t))))))
+
+ (kill-buffer (current-buffer)))))
+
+(defun message-output (filename)
+ "Append this article to Unix/babyl mail file.."
+ (if (and (file-readable-p filename)
+ (mail-file-babyl-p filename))
+ (gnus-output-to-rmail filename t)
+ (gnus-output-to-mail filename t)))
+
+(defun message-cleanup-headers ()
+ "Do various automatic cleanups of the headers."
+ ;; Remove empty lines in the header.
+ (save-restriction
+ (message-narrow-to-headers)
+ (while (re-search-forward "^[ \t]*\n" nil t)
+ (replace-match "" t t)))
+
+ ;; Correct Newsgroups and Followup-To headers: change sequence of
+ ;; spaces to comma and eliminate spaces around commas. Eliminate
+ ;; embedded line breaks.
+ (goto-char (point-min))
+ (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0)
+ (forward-line 1)
+ (point)))
+ (goto-char (point-min))
+ (while (re-search-forward "\n[ \t]+" nil t)
+ (replace-match " " t t)) ;No line breaks (too confusing)
+ (goto-char (point-min))
+ (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
+ (replace-match "," t t))
+ (goto-char (point-min))
+ ;; Remove trailing commas.
+ (when (re-search-forward ",+$" nil t)
+ (replace-match "" t t)))))
+
+(defun message-make-date ()
+ "Make a valid data header."
+ (let ((now (current-time)))
+ (timezone-make-date-arpa-standard
+ (current-time-string now) (current-time-zone now))))
+
+(defun message-make-message-id ()
+ "Make a unique Message-ID."
+ (concat "<" (message-unique-id)
+ (let ((psubject (save-excursion (message-fetch-field "subject")))
+ (psupersedes
+ (save-excursion (message-fetch-field "supersedes"))))
+ (if (or
+ (and message-reply-headers
+ (mail-header-references message-reply-headers)
+ (mail-header-subject message-reply-headers)
+ psubject
+ (mail-header-subject message-reply-headers)
+ (not (string=
+ (message-strip-subject-re
+ (mail-header-subject message-reply-headers))
+ (message-strip-subject-re psubject))))
+ (and psupersedes
+ (string-match "_-_@" psupersedes)))
+ "_-_" ""))
+ "@" (message-make-fqdn) ">"))
+
+(defvar message-unique-id-char nil)
+
+;; If you ever change this function, make sure the new version
+;; cannot generate IDs that the old version could.
+;; You might for example insert a "." somewhere (not next to another dot
+;; or string boundary), or modify the "fsf" string.
+(defun message-unique-id ()
+ ;; Don't use microseconds from (current-time), they may be unsupported.
+ ;; Instead we use this randomly inited counter.
+ (setq message-unique-id-char
+ (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20)))))
+ ;; (current-time) returns 16-bit ints,
+ ;; and 2^16*25 just fits into 4 digits i base 36.
+ (* 25 25)))
+ (let ((tm (current-time)))
+ (concat
+ (if (memq system-type '(ms-dos emx vax-vms))
+ (let ((user (downcase (user-login-name))))
+ (while (string-match "[^a-z0-9_]" user)
+ (aset user (match-beginning 0) ?_))
+ user)
+ (message-number-base36 (user-uid) -1))
+ (message-number-base36 (+ (car tm)
+ (lsh (% message-unique-id-char 25) 16)) 4)
+ (message-number-base36 (+ (nth 1 tm)
+ (lsh (/ message-unique-id-char 25) 16)) 4)
+ ;; Append the newsreader name, because while the generated
+ ;; ID is unique to this newsreader, other newsreaders might
+ ;; otherwise generate the same ID via another algorithm.
+ ".fsf")))
+
+(defun message-number-base36 (num len)
+ (if (if (< len 0)
+ (<= num 0)
+ (= len 0))
+ ""
+ (concat (message-number-base36 (/ num 36) (1- len))
+ (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
+ (% num 36))))))
+
+(defun message-make-organization ()
+ "Make an Organization header."
+ (let* ((organization
+ (or (getenv "ORGANIZATION")
+ (when message-user-organization
+ (if (message-functionp message-user-organization)
+ (funcall message-user-organization)
+ message-user-organization)))))
+ (save-excursion
+ (message-set-work-buffer)
+ (cond ((stringp organization)
+ (insert organization))
+ ((and (eq t organization)
+ message-user-organization-file
+ (file-exists-p message-user-organization-file))
+ (insert-file-contents message-user-organization-file)))
+ (goto-char (point-min))
+ (while (re-search-forward "[\t\n]+" nil t)
+ (replace-match "" t t))
+ (unless (zerop (buffer-size))
+ (buffer-string)))))
+
+(defun message-make-lines ()
+ "Count the number of lines and return numeric string."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
+ (int-to-string (count-lines (point) (point-max))))))
+
+(defun message-make-in-reply-to ()
+ "Return the In-Reply-To header for this message."
+ (when message-reply-headers
+ (let ((from (mail-header-from message-reply-headers))
+ (date (mail-header-date message-reply-headers)))
+ (when from
+ (let ((stop-pos
+ (string-match " *at \\| *@ \\| *(\\| *<" from)))
+ (concat (if stop-pos (substring from 0 stop-pos) from)
+ "'s message of \""
+ (if (or (not date) (string= date ""))
+ "(unknown date)" date)
+ "\""))))))
+
+(defun message-make-distribution ()
+ "Make a Distribution header."
+ (let ((orig-distribution (message-fetch-reply-field "distribution")))
+ (cond ((message-functionp message-distribution-function)
+ (funcall message-distribution-function))
+ (t orig-distribution))))
+
+(defun message-make-expires ()
+ "Return an Expires header based on `message-expires'."
+ (let ((current (current-time))
+ (future (* 1.0 message-expires 60 60 24)))
+ ;; Add the future to current.
+ (setcar current (+ (car current) (round (/ future (expt 2 16)))))
+ (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
+ ;; Return the date in the future in UT.
+ (timezone-make-date-arpa-standard
+ (current-time-string current) (current-time-zone current) '(0 "UT"))))
+
+(defun message-make-path ()
+ "Return uucp path."
+ (let ((login-name (user-login-name)))
+ (cond ((null message-user-path)
+ (concat (system-name) "!" login-name))
+ ((stringp message-user-path)
+ ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com.
+ (concat message-user-path "!" login-name))
+ (t login-name))))
+
+(defun message-make-from ()
+ "Make a From header."
+ (let* ((style message-from-style)
+ (login (message-make-address))
+ (fullname
+ (or (and (boundp 'user-full-name)
+ user-full-name)
+ (user-full-name))))
+ (when (string= fullname "&")
+ (setq fullname (user-login-name)))
+ (save-excursion
+ (message-set-work-buffer)
+ (cond
+ ((or (null style)
+ (equal fullname ""))
+ (insert login))
+ ((or (eq style 'angles)
+ (and (not (eq style 'parens))
+ ;; Use angles if no quoting is needed, or if parens would
+ ;; need quoting too.
+ (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname))
+ (let ((tmp (concat fullname nil)))
+ (while (string-match "([^()]*)" tmp)
+ (aset tmp (match-beginning 0) ?-)
+ (aset tmp (1- (match-end 0)) ?-))
+ (string-match "[\\()]" tmp)))))
+ (insert fullname)
+ (goto-char (point-min))
+ ;; Look for a character that cannot appear unquoted
+ ;; according to RFC 822.
+ (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
+ ;; Quote fullname, escaping specials.
+ (goto-char (point-min))
+ (insert "\"")
+ (while (re-search-forward "[\"\\]" nil 1)
+ (replace-match "\\\\\\&" t))
+ (insert "\""))
+ (insert " <" login ">"))
+ (t ; 'parens or default
+ (insert login " (")
+ (let ((fullname-start (point)))
+ (insert fullname)
+ (goto-char fullname-start)
+ ;; RFC 822 says \ and nonmatching parentheses
+ ;; must be escaped in comments.
+ ;; Escape every instance of ()\ ...
+ (while (re-search-forward "[()\\]" nil 1)
+ (replace-match "\\\\\\&" t))
+ ;; ... then undo escaping of matching parentheses,
+ ;; including matching nested parentheses.
+ (goto-char fullname-start)
+ (while (re-search-forward
+ "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
+ nil 1)
+ (replace-match "\\1(\\3)" t)
+ (goto-char fullname-start)))
+ (insert ")")))
+ (buffer-string))))
+
+(defun message-make-sender ()
+ "Return the \"real\" user address.
+This function tries to ignore all user modifications, and
+give as trustworthy answer as possible."
+ (concat (user-login-name) "@" (system-name)))
+
+(defun message-make-address ()
+ "Make the address of the user."
+ (or (message-user-mail-address)
+ (concat (user-login-name) "@" (message-make-domain))))
+
+(defun message-user-mail-address ()
+ "Return the pertinent part of `user-mail-address'."
+ (when user-mail-address
+ (if (string-match " " user-mail-address)
+ (nth 1 (mail-extract-address-components user-mail-address))
+ user-mail-address)))
+
+(defun message-make-fqdn ()
+ "Return user's fully qualified domain name."
+ (let ((system-name (system-name))
+ (user-mail (message-user-mail-address)))
+ (cond
+ ((string-match "[^.]\\.[^.]" system-name)
+ ;; `system-name' returned the right result.
+ system-name)
+ ;; Try `mail-host-address'.
+ ((and (boundp 'mail-host-address)
+ (stringp mail-host-address)
+ (string-match "\\." mail-host-address))
+ mail-host-address)
+ ;; We try `user-mail-address' as a backup.
+ ((and (string-match "\\." user-mail)
+ (string-match "@\\(.*\\)\\'" user-mail))
+ (match-string 1 user-mail))
+ ;; Default to this bogus thing.
+ (t
+ (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me")))))
+
+(defun message-make-host-name ()
+ "Return the name of the host."
+ (let ((fqdn (message-make-fqdn)))
+ (string-match "^[^.]+\\." fqdn)
+ (substring fqdn 0 (1- (match-end 0)))))
+
+(defun message-make-domain ()
+ "Return the domain name."
+ (or mail-host-address
+ (message-make-fqdn)))
+
+(defun message-generate-headers (headers)
+ "Prepare article HEADERS.
+Headers already prepared in the buffer are not modified."
+ (save-restriction
+ (message-narrow-to-headers)
+ (let* ((Date (message-make-date))
+ (Message-ID (message-make-message-id))
+ (Organization (message-make-organization))
+ (From (message-make-from))
+ (Path (message-make-path))
+ (Subject nil)
+ (Newsgroups nil)
+ (In-Reply-To (message-make-in-reply-to))
+ (To nil)
+ (Distribution (message-make-distribution))
+ (Lines (message-make-lines))
+ (X-Newsreader message-newsreader)
+ (X-Mailer (and (not (message-fetch-field "X-Newsreader"))
+ message-mailer))
+ (Expires (message-make-expires))
+ (case-fold-search t)
+ header value elem)
+ ;; First we remove any old generated headers.
+ (let ((headers message-deletable-headers))
+ (unless (buffer-modified-p)
+ (setq headers (delq 'Message-ID (copy-sequence headers))))
+ (while headers
+ (goto-char (point-min))
+ (and (re-search-forward
+ (concat "^" (symbol-name (car headers)) ": *") nil t)
+ (get-text-property (1+ (match-beginning 0)) 'message-deletable)
+ (message-delete-line))
+ (pop headers)))
+ ;; Go through all the required headers and see if they are in the
+ ;; articles already. If they are not, or are empty, they are
+ ;; inserted automatically - except for Subject, Newsgroups and
+ ;; Distribution.
+ (while headers
+ (goto-char (point-min))
+ (setq elem (pop headers))
+ (if (consp elem)
+ (if (eq (car elem) 'optional)
+ (setq header (cdr elem))
+ (setq header (car elem)))
+ (setq header elem))
+ (when (or (not (re-search-forward
+ (concat "^" (downcase (symbol-name header)) ":")
+ nil t))
+ (progn
+ ;; The header was found. We insert a space after the
+ ;; colon, if there is none.
+ (if (/= (following-char) ? ) (insert " ") (forward-char 1))
+ ;; Find out whether the header is empty...
+ (looking-at "[ \t]*$")))
+ ;; So we find out what value we should insert.
+ (setq value
+ (cond
+ ((and (consp elem) (eq (car elem) 'optional))
+ ;; This is an optional header. If the cdr of this
+ ;; is something that is nil, then we do not insert
+ ;; this header.
+ (setq header (cdr elem))
+ (or (and (fboundp (cdr elem)) (funcall (cdr elem)))
+ (and (boundp (cdr elem)) (symbol-value (cdr elem)))))
+ ((consp elem)
+ ;; The element is a cons. Either the cdr is a
+ ;; string to be inserted verbatim, or it is a
+ ;; function, and we insert the value returned from
+ ;; this function.
+ (or (and (stringp (cdr elem)) (cdr elem))
+ (and (fboundp (cdr elem)) (funcall (cdr elem)))))
+ ((and (boundp header) (symbol-value header))
+ ;; The element is a symbol. We insert the value
+ ;; of this symbol, if any.
+ (symbol-value header))
+ (t
+ ;; We couldn't generate a value for this header,
+ ;; so we just ask the user.
+ (read-from-minibuffer
+ (format "Empty header for %s; enter value: " header)))))
+ ;; Finally insert the header.
+ (when (and value
+ (not (equal value "")))
+ (save-excursion
+ (if (bolp)
+ (progn
+ ;; This header didn't exist, so we insert it.
+ (goto-char (point-max))
+ (insert (symbol-name header) ": " value "\n")
+ (forward-line -1))
+ ;; The value of this header was empty, so we clear
+ ;; totally and insert the new value.
+ (delete-region (point) (gnus-point-at-eol))
+ (insert value))
+ ;; Add the deletable property to the headers that require it.
+ (and (memq header message-deletable-headers)
+ (progn (beginning-of-line) (looking-at "[^:]+: "))
+ (add-text-properties
+ (point) (match-end 0)
+ '(message-deletable t face italic) (current-buffer)))))))
+ ;; Insert new Sender if the From is strange.
+ (let ((from (message-fetch-field "from"))
+ (sender (message-fetch-field "sender"))
+ (secure-sender (message-make-sender)))
+ (when (and from
+ (not (message-check-element 'sender))
+ (not (string=
+ (downcase
+ (cadr (mail-extract-address-components from)))
+ (downcase secure-sender)))
+ (or (null sender)
+ (not
+ (string=
+ (downcase
+ (cadr (mail-extract-address-components sender)))
+ (downcase secure-sender)))))
+ (goto-char (point-min))
+ ;; Rename any old Sender headers to Original-Sender.
+ (when (re-search-forward "^\\(Original-\\)*Sender:" nil t)
+ (beginning-of-line)
+ (insert "Original-")
+ (beginning-of-line))
+ (when (or (message-news-p)
+ (string-match "^[^@]@.+\\..+" secure-sender))
+ (insert "Sender: " secure-sender "\n")))))))
+
+(defun message-insert-courtesy-copy ()
+ "Insert a courtesy message in mail copies of combined messages."
+ (let (newsgroups)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (when (setq newsgroups (message-fetch-field "newsgroups"))
+ (goto-char (point-max))
+ (insert "Posted-To: " newsgroups "\n")))
+ (forward-line 1)
+ (when message-courtesy-message
+ (cond
+ ((string-match "%s" message-courtesy-message)
+ (insert (format message-courtesy-message newsgroups)))
+ (t
+ (insert message-courtesy-message)))))))
+
+;;;
+;;; Setting up a message buffer
+;;;
+
+(defun message-fill-address (header value)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert (capitalize (symbol-name header))
+ ": "
+ (if (consp value) (car value) value)
+ "\n")
+ (narrow-to-region (point-min) (1- (point-max)))
+ (let (quoted last)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward "^,\"" (point-max))
+ (if (or (= (following-char) ?,)
+ (eobp))
+ (when (not quoted)
+ (if (and (> (current-column) 78)
+ last)
+ (progn
+ (save-excursion
+ (goto-char last)
+ (insert "\n\t"))
+ (setq last (1+ (point))))
+ (setq last (1+ (point)))))
+ (setq quoted (not quoted)))
+ (unless (eobp)
+ (forward-char 1))))
+ (goto-char (point-max))
+ (widen)
+ (forward-line 1)))
+
+(defun message-fill-header (header value)
+ (let ((begin (point))
+ (fill-column 78)
+ (fill-prefix "\t"))
+ (insert (capitalize (symbol-name header))
+ ": "
+ (if (consp value) (car value) value)
+ "\n")
+ (save-restriction
+ (narrow-to-region begin (point))
+ (fill-region-as-paragraph begin (point))
+ ;; Tapdance around looong Message-IDs.
+ (forward-line -1)
+ (when (looking-at "[ \t]*$")
+ (message-delete-line))
+ (goto-char begin)
+ (re-search-forward ":" nil t)
+ (when (looking-at "\n[ \t]+")
+ (replace-match " " t t))
+ (goto-char (point-max)))))
+
+(defun message-position-point ()
+ "Move point to where the user probably wants to find it."
+ (message-narrow-to-headers)
+ (cond
+ ((re-search-forward "^[^:]+:[ \t]*$" nil t)
+ (search-backward ":" )
+ (widen)
+ (forward-char 1)
+ (if (= (following-char) ? )
+ (forward-char 1)
+ (insert " ")))
+ (t
+ (goto-char (point-max))
+ (widen)
+ (forward-line 1)
+ (unless (looking-at "$")
+ (forward-line 2)))
+ (sit-for 0)))
+
+(defun message-buffer-name (type &optional to group)
+ "Return a new (unique) buffer name based on TYPE and TO."
+ (cond
+ ;; Check whether `message-generate-new-buffers' is a function,
+ ;; and if so, call it.
+ ((message-functionp message-generate-new-buffers)
+ (funcall message-generate-new-buffers type to group))
+ ;; Generate a new buffer name The Message Way.
+ (message-generate-new-buffers
+ (generate-new-buffer-name
+ (concat "*" type
+ (if to
+ (concat " to "
+ (or (car (mail-extract-address-components to))
+ to) "")
+ "")
+ (if (and group (not (string= group ""))) (concat " on " group) "")
+ "*")))
+ ;; Use standard name.
+ (t
+ (format "*%s message*" type))))
+
+(defun message-pop-to-buffer (name)
+ "Pop to buffer NAME, and warn if it already exists and is modified."
+ (let ((buffer (get-buffer name)))
+ (if (and buffer
+ (buffer-name buffer))
+ (progn
+ (set-buffer (pop-to-buffer buffer))
+ (when (and (buffer-modified-p)
+ (not (y-or-n-p
+ "Message already being composed; erase? ")))
+ (error "Message being composed")))
+ (set-buffer (pop-to-buffer name))))
+ (erase-buffer)
+ (message-mode))
+
+(defun message-do-send-housekeeping ()
+ "Kill old message buffers."
+ ;; We might have sent this buffer already. Delete it from the
+ ;; list of buffers.
+ (setq message-buffer-list (delq (current-buffer) message-buffer-list))
+ (while (and message-max-buffers
+ message-buffer-list
+ (>= (length message-buffer-list) message-max-buffers))
+ ;; Kill the oldest buffer -- unless it has been changed.
+ (let ((buffer (pop message-buffer-list)))
+ (when (and (buffer-name buffer)
+ (not (buffer-modified-p buffer)))
+ (kill-buffer buffer))))
+ ;; Rename the buffer.
+ (if message-send-rename-function
+ (funcall message-send-rename-function)
+ (when (string-match "\\`\\*" (buffer-name))
+ (rename-buffer
+ (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
+ ;; Push the current buffer onto the list.
+ (when message-max-buffers
+ (setq message-buffer-list
+ (nconc message-buffer-list (list (current-buffer))))))
+
+(defvar mc-modes-alist)
+(defun message-setup (headers &optional replybuffer actions)
+ (when (and (boundp 'mc-modes-alist)
+ (not (assq 'message-mode mc-modes-alist)))
+ (push '(message-mode (encrypt . mc-encrypt-message)
+ (sign . mc-sign-message))
+ mc-modes-alist))
+ (when actions
+ (setq message-send-actions actions))
+ (setq message-reply-buffer replybuffer)
+ (goto-char (point-min))
+ ;; Insert all the headers.
+ (mail-header-format
+ (let ((h headers)
+ (alist message-header-format-alist))
+ (while h
+ (unless (assq (caar h) message-header-format-alist)
+ (push (list (caar h)) alist))
+ (pop h))
+ alist)
+ headers)
+ (delete-region (point) (progn (forward-line -1) (point)))
+ (when message-default-headers
+ (insert message-default-headers))
+ (put-text-property
+ (point)
+ (progn
+ (insert mail-header-separator "\n")
+ (1- (point)))
+ 'read-only nil)
+ (forward-line -1)
+ (when (message-news-p)
+ (when message-default-news-headers
+ (insert message-default-news-headers))
+ (when message-generate-headers-first
+ (message-generate-headers
+ (delq 'Lines
+ (delq 'Subject
+ (copy-sequence message-required-news-headers))))))
+ (when (message-mail-p)
+ (when message-default-mail-headers
+ (insert message-default-mail-headers))
+ (when message-generate-headers-first
+ (message-generate-headers
+ (delq 'Lines
+ (delq 'Subject
+ (copy-sequence message-required-mail-headers))))))
+ (run-hooks 'message-signature-setup-hook)
+ (message-insert-signature)
+ (save-restriction
+ (message-narrow-to-headers)
+ (run-hooks 'message-header-setup-hook))
+ (set-buffer-modified-p nil)
+ (setq buffer-undo-list nil)
+ (run-hooks 'message-setup-hook)
+ (message-position-point)
+ (undo-boundary))
+
+(defun message-set-auto-save-file-name ()
+ "Associate the message buffer with a file in the drafts directory."
+ (when message-autosave-directory
+ (setq message-draft-article (nndraft-request-associate-buffer "drafts"))
+ (clear-visited-file-modtime)))
+
+(defun message-disassociate-draft ()
+ "Disassociate the message buffer from the drafts directory."
+ (when message-draft-article
+ (nndraft-request-expire-articles
+ (list message-draft-article) "drafts" nil t)))
+
+\f
+
+;;;
+;;; Commands for interfacing with message
+;;;
+
+;;;###autoload
+(defun message-mail (&optional to subject
+ other-headers continue switch-function
+ yank-action send-actions)
+ "Start editing a mail message to be sent."
+ (interactive)
+ (let ((message-this-is-mail t))
+ (message-pop-to-buffer (message-buffer-name "mail" to))
+ (message-setup
+ (nconc
+ `((To . ,(or to "")) (Subject . ,(or subject "")))
+ (when other-headers other-headers)))))
+
+;;;###autoload
+(defun message-news (&optional newsgroups subject)
+ "Start editing a news article to be sent."
+ (interactive)
+ (let ((message-this-is-news t))
+ (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
+ (message-setup `((Newsgroups . ,(or newsgroups ""))
+ (Subject . ,(or subject ""))))))
+
+;;;###autoload
+(defun message-reply (&optional to-address wide ignore-reply-to)
+ "Start editing a reply to the article in the current buffer."
+ (interactive)
+ (let ((cur (current-buffer))
+ from subject date reply-to to cc
+ references message-id follow-to
+ (inhibit-point-motion-hooks t)
+ mct never-mct gnus-warning)
+ (save-restriction
+ (message-narrow-to-head)
+ ;; Allow customizations to have their say.
+ (if (not wide)
+ ;; This is a regular reply.
+ (if (message-functionp message-reply-to-function)
+ (setq follow-to (funcall message-reply-to-function)))
+ ;; This is a followup.
+ (if (message-functionp message-wide-reply-to-function)
+ (save-excursion
+ (setq follow-to
+ (funcall message-wide-reply-to-function)))))
+ ;; Find all relevant headers we need.
+ (setq from (message-fetch-field "from")
+ date (message-fetch-field "date")
+ subject (or (message-fetch-field "subject") "none")
+ to (message-fetch-field "to")
+ cc (message-fetch-field "cc")
+ mct (message-fetch-field "mail-copies-to")
+ reply-to (unless ignore-reply-to (message-fetch-field "reply-to"))
+ references (message-fetch-field "references")
+ message-id (message-fetch-field "message-id" t))
+ ;; Remove any (buggy) Re:'s that are present and make a
+ ;; proper one.
+ (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
+ (setq subject (substring subject (match-end 0))))
+ (setq subject (concat "Re: " subject))
+
+ (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
+ (string-match "<[^>]+>" gnus-warning))
+ (setq message-id (match-string 0 gnus-warning)))
+
+ ;; Handle special values of Mail-Copies-To.
+ (when mct
+ (cond ((equal (downcase mct) "never")
+ (setq never-mct t)
+ (setq mct nil))
+ ((equal (downcase mct) "always")
+ (setq mct (or reply-to from)))))
+
+ (unless follow-to
+ (if (or (not wide)
+ to-address)
+ (setq follow-to (list (cons 'To (or to-address reply-to from))))
+ (let (ccalist)
+ (save-excursion
+ (message-set-work-buffer)
+ (unless never-mct
+ (insert (or reply-to from "")))
+ (insert (if to (concat (if (bolp) "" ", ") to "") ""))
+ (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
+ (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
+ (goto-char (point-min))
+ (while (re-search-forward "[ \t]+" nil t)
+ (replace-match " " t t))
+ ;; Remove addresses that match `rmail-dont-reply-to-names'.
+ (insert (prog1 (rmail-dont-reply-to (buffer-string))
+ (erase-buffer)))
+ (goto-char (point-min))
+ ;; Perhaps Mail-Copies-To: never removed the only address?
+ (when (eobp)
+ (insert (or reply-to from "")))
+ (setq ccalist
+ (mapcar
+ (lambda (addr)
+ (cons (mail-strip-quoted-names addr) addr))
+ (message-tokenize-header (buffer-string))))
+ (let ((s ccalist))
+ (while s
+ (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
+ (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
+ (when ccalist
+ (let ((ccs (cons 'Cc (mapconcat
+ (lambda (addr) (cdr addr)) ccalist ", "))))
+ (when (string-match "^ +" (cdr ccs))
+ (setcdr ccs (substring (cdr ccs) (match-end 0))))
+ (push ccs follow-to))))))
+ (widen))
+
+ (message-pop-to-buffer (message-buffer-name
+ (if wide "wide reply" "reply") from
+ (if wide to-address nil)))
+
+ (setq message-reply-headers
+ (vector 0 subject from date message-id references 0 0 ""))
+
+ (message-setup
+ `((Subject . ,subject)
+ ,@follow-to
+ ,@(if (or references message-id)
+ `((References . ,(concat (or references "") (and references " ")
+ (or message-id ""))))
+ nil))
+ cur)))
+
+;;;###autoload
+(defun message-wide-reply (&optional to-address ignore-reply-to)
+ "Make a \"wide\" reply to the message in the current buffer."
+ (interactive)
+ (message-reply to-address t ignore-reply-to))
+
+;;;###autoload
+(defun message-followup (&optional to-newsgroups)
+ "Follow up to the message in the current buffer.
+If TO-NEWSGROUPS, use that as the new Newsgroups line."
+ (interactive)
+ (let ((cur (current-buffer))
+ from subject date reply-to mct
+ references message-id follow-to
+ (inhibit-point-motion-hooks t)
+ (message-this-is-news t)
+ followup-to distribution newsgroups gnus-warning posted-to)
+ (save-restriction
+ (narrow-to-region
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (when (message-functionp message-followup-to-function)
+ (setq follow-to
+ (funcall message-followup-to-function)))
+ (setq from (message-fetch-field "from")
+ date (message-fetch-field "date")
+ subject (or (message-fetch-field "subject") "none")
+ references (message-fetch-field "references")
+ message-id (message-fetch-field "message-id" t)
+ followup-to (message-fetch-field "followup-to")
+ newsgroups (message-fetch-field "newsgroups")
+ posted-to (message-fetch-field "posted-to")
+ reply-to (message-fetch-field "reply-to")
+ distribution (message-fetch-field "distribution")
+ mct (message-fetch-field "mail-copies-to"))
+ (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
+ (string-match "<[^>]+>" gnus-warning))
+ (setq message-id (match-string 0 gnus-warning)))
+ ;; Remove bogus distribution.
+ (when (and (stringp distribution)
+ (let ((case-fold-search t))
+ (string-match "world" distribution)))
+ (setq distribution nil))
+ ;; Remove any (buggy) Re:'s that are present and make a
+ ;; proper one.
+ (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
+ (setq subject (substring subject (match-end 0))))
+ (setq subject (concat "Re: " subject))
+ (widen))
+
+ (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
+
+ (message-setup
+ `((Subject . ,subject)
+ ,@(cond
+ (to-newsgroups
+ (list (cons 'Newsgroups to-newsgroups)))
+ (follow-to follow-to)
+ ((and followup-to message-use-followup-to)
+ (list
+ (cond
+ ((equal (downcase followup-to) "poster")
+ (if (or (eq message-use-followup-to 'use)
+ (message-y-or-n-p "Obey Followup-To: poster? " t "\
+You should normally obey the Followup-To: header.
+
+`Followup-To: poster' sends your response via e-mail instead of news.
+
+A typical situation where `Followup-To: poster' is used is when the poster
+does not read the newsgroup, so he wouldn't see any replies sent to it."))
+ (progn
+ (setq message-this-is-news nil)
+ (cons 'To (or reply-to from "")))
+ (cons 'Newsgroups newsgroups)))
+ (t
+ (if (or (equal followup-to newsgroups)
+ (not (eq message-use-followup-to 'ask))
+ (message-y-or-n-p
+ (concat "Obey Followup-To: " followup-to "? ") t "\
+You should normally obey the Followup-To: header.
+
+ `Followup-To: " followup-to "'
+directs your response to " (if (string-match "," followup-to)
+ "the specified newsgroups"
+ "that newsgroup only") ".
+
+If a message is posted to several newsgroups, Followup-To is often
+used to direct the following discussion to one newsgroup only,
+because discussions that are spread over several newsgroup tend to
+be fragmented and very difficult to follow.
+
+Also, some source/announcement newsgroups are not indented for discussion;
+responses here are directed to other newsgroups."))
+ (cons 'Newsgroups followup-to)
+ (cons 'Newsgroups newsgroups))))))
+ (posted-to
+ `((Newsgroups . ,posted-to)))
+ (t
+ `((Newsgroups . ,newsgroups))))
+ ,@(and distribution (list (cons 'Distribution distribution)))
+ ,@(if (or references message-id)
+ `((References . ,(concat (or references "") (and references " ")
+ (or message-id "")))))
+ ,@(when (and mct
+ (not (equal (downcase mct) "never")))
+ (list (cons 'Cc (if (equal (downcase mct) "always")
+ (or reply-to from "")
+ mct)))))
+
+ cur)
+
+ (setq message-reply-headers
+ (vector 0 subject from date message-id references 0 0 ""))))
+
+
+;;;###autoload
+(defun message-cancel-news ()
+ "Cancel an article you posted."
+ (interactive)
+ (unless (message-news-p)
+ (error "This is not a news article; canceling is impossible"))
+ (when (yes-or-no-p "Do you really want to cancel this article? ")
+ (let (from newsgroups message-id distribution buf)
+ (save-excursion
+ ;; Get header info. from original article.
+ (save-restriction
+ (message-narrow-to-head)
+ (setq from (message-fetch-field "from")
+ newsgroups (message-fetch-field "newsgroups")
+ message-id (message-fetch-field "message-id" t)
+ distribution (message-fetch-field "distribution")))
+ ;; Make sure that this article was written by the user.
+ (unless (string-equal
+ (downcase (cadr (mail-extract-address-components from)))
+ (downcase (message-make-address)))
+ (error "This article is not yours"))
+ ;; Make control message.
+ (setq buf (set-buffer (get-buffer-create " *message cancel*")))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert "Newsgroups: " newsgroups "\n"
+ "From: " (message-make-from) "\n"
+ "Subject: cmsg cancel " message-id "\n"
+ "Control: cancel " message-id "\n"
+ (if distribution
+ (concat "Distribution: " distribution "\n")
+ "")
+ mail-header-separator "\n"
+ message-cancel-message)
+ (message "Canceling your article...")
+ (if (let ((message-syntax-checks
+ 'dont-check-for-anything-just-trust-me))
+ (funcall message-send-news-function))
+ (message "Canceling your article...done"))
+ (kill-buffer buf)))))
+
+;;;###autoload
+(defun message-supersede ()
+ "Start composing a message to supersede the current message.
+This is done simply by taking the old article and adding a Supersedes
+header line with the old Message-ID."
+ (interactive)
+ (let ((cur (current-buffer)))
+ ;; Check whether the user owns the article that is to be superseded.
+ (unless (string-equal
+ (downcase (cadr (mail-extract-address-components
+ (message-fetch-field "from"))))
+ (downcase (message-make-address)))
+ (error "This article is not yours"))
+ ;; Get a normal message buffer.
+ (message-pop-to-buffer (message-buffer-name "supersede"))
+ (insert-buffer-substring cur)
+ (message-narrow-to-head)
+ ;; Remove unwanted headers.
+ (when message-ignored-supersedes-headers
+ (message-remove-header message-ignored-supersedes-headers t))
+ (goto-char (point-min))
+ (if (not (re-search-forward "^Message-ID: " nil t))
+ (error "No Message-ID in this article")
+ (replace-match "Supersedes: " t t))
+ (goto-char (point-max))
+ (insert mail-header-separator)
+ (widen)
+ (forward-line 1)))
+
+;;;###autoload
+(defun message-recover ()
+ "Reread contents of current buffer from its last auto-save file."
+ (interactive)
+ (let ((file-name (make-auto-save-file-name)))
+ (cond ((save-window-excursion
+ (if (not (eq system-type 'vax-vms))
+ (with-output-to-temp-buffer "*Directory*"
+ (buffer-disable-undo standard-output)
+ (let ((default-directory "/"))
+ (call-process
+ "ls" nil standard-output nil "-l" file-name))))
+ (yes-or-no-p (format "Recover auto save file %s? " file-name)))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (insert-file-contents file-name nil)))
+ (t (error "message-recover cancelled")))))
+
+;;; Forwarding messages.
+
+(defun message-make-forward-subject ()
+ "Return a Subject header suitable for the message in the current buffer."
+ (save-excursion
+ (save-restriction
+ (current-buffer)
+ (message-narrow-to-head)
+ (concat "[" (or (message-fetch-field
+ (if (message-news-p) "newsgroups" "from"))
+ "(nowhere)")
+ "] " (or (message-fetch-field "Subject") "")))))
+
+;;;###autoload
+(defun message-forward (&optional news)
+ "Forward the current message via mail.
+Optional NEWS will use news to forward instead of mail."
+ (interactive "P")
+ (let ((cur (current-buffer))
+ (subject (message-make-forward-subject))
+ art-beg)
+ (if news (message-news nil subject) (message-mail nil subject))
+ ;; Put point where we want it before inserting the forwarded
+ ;; message.
+ (if message-signature-before-forwarded-message
+ (goto-char (point-max))
+ (message-goto-body))
+ ;; Make sure we're at the start of the line.
+ (unless (eolp)
+ (insert "\n"))
+ ;; Narrow to the area we are to insert.
+ (narrow-to-region (point) (point))
+ ;; Insert the separators and the forwarded buffer.
+ (insert message-forward-start-separator)
+ (setq art-beg (point))
+ (insert-buffer-substring cur)
+ (goto-char (point-max))
+ (insert message-forward-end-separator)
+ (set-text-properties (point-min) (point-max) nil)
+ ;; Remove all unwanted headers.
+ (goto-char art-beg)
+ (narrow-to-region (point) (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point)))
+ (goto-char (point-min))
+ (message-remove-header message-included-forward-headers t nil t)
+ (widen)
+ (message-position-point)))
+
+;;;###autoload
+(defun message-resend (address)
+ "Resend the current article to ADDRESS."
+ (interactive "sResend message to: ")
+ (message "Resending message to %s..." address)
+ (save-excursion
+ (let ((cur (current-buffer))
+ beg)
+ ;; We first set up a normal mail buffer.
+ (set-buffer (get-buffer-create " *message resend*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (message-setup `((To . ,address)))
+ ;; Insert our usual headers.
+ (message-generate-headers '(From Date To))
+ (message-narrow-to-headers)
+ ;; Rename them all to "Resent-*".
+ (while (re-search-forward "^[A-Za-z]" nil t)
+ (forward-char -1)
+ (insert "Resent-"))
+ (widen)
+ (forward-line)
+ (delete-region (point) (point-max))
+ (setq beg (point))
+ ;; Insert the message to be resent.
+ (insert-buffer-substring cur)
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (save-restriction
+ (narrow-to-region beg (point))
+ (message-remove-header message-ignored-resent-headers t)
+ (goto-char (point-max)))
+ (insert mail-header-separator)
+ ;; Rename all old ("Also-")Resent headers.
+ (while (re-search-backward "^\\(Also-\\)?Resent-" beg t)
+ (beginning-of-line)
+ (insert "Also-"))
+ ;; Quote any "From " lines at the beginning.
+ (goto-char beg)
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ ;; Send it.
+ (message-send-mail)
+ (kill-buffer (current-buffer)))
+ (message "Resending message to %s...done" address)))
+
+;;;###autoload
+(defun message-bounce ()
+ "Re-mail the current message.
+This only makes sense if the current message is a bounce message than
+contains some mail you have written which has been bounced back to
+you."
+ (interactive)
+ (let ((cur (current-buffer))
+ boundary)
+ (message-pop-to-buffer (message-buffer-name "bounce"))
+ (insert-buffer-substring cur)
+ (undo-boundary)
+ (message-narrow-to-head)
+ (if (and (message-fetch-field "Mime-Version")
+ (setq boundary (message-fetch-field "Content-Type")))
+ (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary)
+ (setq boundary (concat (match-string 1 boundary) " *\n"
+ "Content-Type: message/rfc822"))
+ (setq boundary nil)))
+ (widen)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (or (and boundary
+ (re-search-forward boundary nil t)
+ (forward-line 2))
+ (and (re-search-forward message-unsent-separator nil t)
+ (forward-line 1))
+ (re-search-forward "^Return-Path:.*\n" nil t))
+ ;; We remove everything before the bounced mail.
+ (delete-region
+ (point-min)
+ (if (re-search-forward "^[^ \n\t]+:" nil t)
+ (match-beginning 0)
+ (point)))
+ (save-restriction
+ (message-narrow-to-head)
+ (message-remove-header message-ignored-bounced-headers t)
+ (goto-char (point-max))
+ (insert mail-header-separator))
+ (message-position-point)))
+
+;;;
+;;; Interactive entry points for new message buffers.
+;;;
+
+;;;###autoload
+(defun message-mail-other-window (&optional to subject)
+ "Like `message-mail' command, but display mail buffer in another window."
+ (interactive)
+ (let ((pop-up-windows t)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (same-window-regexps nil))
+ (message-pop-to-buffer (message-buffer-name "mail" to)))
+ (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-mail-other-frame (&optional to subject)
+ "Like `message-mail' command, but display mail buffer in another frame."
+ (interactive)
+ (let ((pop-up-frames t)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (same-window-regexps nil))
+ (message-pop-to-buffer (message-buffer-name "mail" to)))
+ (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-news-other-window (&optional newsgroups subject)
+ "Start editing a news article to be sent."
+ (interactive)
+ (let ((pop-up-windows t)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (same-window-regexps nil))
+ (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+ (message-setup `((Newsgroups . ,(or newsgroups ""))
+ (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-news-other-frame (&optional newsgroups subject)
+ "Start editing a news article to be sent."
+ (interactive)
+ (let ((pop-up-frames t)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (same-window-regexps nil))
+ (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+ (message-setup `((Newsgroups . ,(or newsgroups ""))
+ (Subject . ,(or subject "")))))
+
+;;; underline.el
+
+;; This code should be moved to underline.el (from which it is stolen).
+
+;;;###autoload
+(defun bold-region (start end)
+ "Bold all nonblank characters in the region.
+Works by overstriking characters.
+Called from program, takes two arguments START and END
+which specify the range to operate on."
+ (interactive "r")
+ (save-excursion
+ (let ((end1 (make-marker)))
+ (move-marker end1 (max start end))
+ (goto-char (min start end))
+ (while (< (point) end1)
+ (or (looking-at "[_\^@- ]")
+ (insert (following-char) "\b"))
+ (forward-char 1)))))
+
+;;;###autoload
+(defun unbold-region (start end)
+ "Remove all boldness (overstruck characters) in the region.
+Called from program, takes two arguments START and END
+which specify the range to operate on."
+ (interactive "r")
+ (save-excursion
+ (let ((end1 (make-marker)))
+ (move-marker end1 (max start end))
+ (goto-char (min start end))
+ (while (re-search-forward "\b" end1 t)
+ (if (eq (following-char) (char-after (- (point) 2)))
+ (delete-char -2))))))
+
+(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
+
+;; Support for toolbar
+(when (string-match "XEmacs\\|Lucid" emacs-version)
+ (require 'messagexmas))
+
+;;; Group name completion.
+
+(defvar message-newgroups-header-regexp
+ "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"
+ "Regexp that match headers that lists groups.")
+
+(defun message-tab ()
+ "Expand group names in Newsgroups and Followup-To headers.
+Do a `tab-to-tab-stop' if not in those headers."
+ (interactive)
+ (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp))
+ (mail-abbrev-in-expansion-header-p))
+ (message-expand-group)
+ (tab-to-tab-stop)))
+
+(defvar gnus-active-hashtb)
+(defun message-expand-group ()
+ (let* ((b (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward "^:")
+ (1+ (point)))
+ (point))
+ (skip-chars-backward "^, \t\n") (point))))
+ (completion-ignore-case t)
+ (string (buffer-substring b (point)))
+ (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb))
+ (completions (all-completions string hashtb))
+ (cur (current-buffer))
+ comp)
+ (delete-region b (point))
+ (cond
+ ((= (length completions) 1)
+ (if (string= (car completions) string)
+ (progn
+ (insert string)
+ (message "Only matching group"))
+ (insert (car completions))))
+ ((and (setq comp (try-completion string hashtb))
+ (not (string= comp string)))
+ (insert comp))
+ (t
+ (insert string)
+ (if (not comp)
+ (message "No matching groups")
+ (save-selected-window
+ (pop-to-buffer "*Completions*")
+ (buffer-disable-undo (current-buffer))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (let ((standard-output (current-buffer)))
+ (display-completion-list (sort completions 'string<)))
+ (goto-char (point-min))
+ (delete-region (point) (progn (forward-line 3) (point))))))))))
+
+;;; Help stuff.
+
+(defun message-talkative-question (ask question show &rest text)
+ "Call FUNCTION with argument QUESTION; optionally display TEXT... args.
+If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer.
+The following arguments may contain lists of values."
+ (if (and show
+ (setq text (message-flatten-list text)))
+ (save-window-excursion
+ (save-excursion
+ (with-output-to-temp-buffer " *MESSAGE information message*"
+ (set-buffer " *MESSAGE information message*")
+ (mapcar 'princ text)
+ (goto-char (point-min))))
+ (funcall ask question))
+ (funcall ask question)))
+
+(defun message-flatten-list (list)
+ "Return a new, flat list that contains all elements of LIST.
+
+\(message-flatten-list '(1 (2 3 (4 5 (6))) 7))
+=> (1 2 3 4 5 6 7)"
+ (cond ((consp list)
+ (apply 'append (mapcar 'message-flatten-list list)))
+ (list
+ (list list))))
+
+(defun message-generate-new-buffer-clone-locals (name &optional varstr)
+ "Create and return a buffer with a name based on NAME using generate-new-buffer.
+Then clone the local variables and values from the old buffer to the
+new one, cloning only the locals having a substring matching the
+regexp varstr."
+ (let ((oldbuf (current-buffer)))
+ (save-excursion
+ (set-buffer (generate-new-buffer name))
+ (message-clone-locals oldbuf)
+ (current-buffer))))
+
+(defun message-clone-locals (buffer)
+ "Clone the local variables from BUFFER to the current buffer."
+ (let ((locals (save-excursion
+ (set-buffer buffer)
+ (buffer-local-variables)))
+ (regexp "^gnus\\|^nn\\|^message"))
+ (mapcar
+ (lambda (local)
+ (when (and (consp local)
+ (car local)
+ (string-match regexp (symbol-name (car local))))
+ (ignore-errors
+ (set (make-local-variable (car local))
+ (cdr local)))))
+ locals)))
+
+;;; Miscellaneous functions
+
+;; stolen (and renamed) from nnheader.el
+(defun message-replace-chars-in-string (string from to)
+ "Replace characters in STRING from FROM to TO."
+ (let ((string (substring string 0)) ;Copy string.
+ (len (length string))
+ (idx 0))
+ ;; Replace all occurrences of FROM with TO.
+ (while (< idx len)
+ (when (= (aref string idx) from)
+ (aset string idx to))
+ (setq idx (1+ idx)))
+ string))
+
+(run-hooks 'message-load-hook)
+
+(provide 'message)
+
+;;; message.el ends here
--- /dev/null
+;;; messagexmas.el --- XEmacs extensions to message
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+
+(defvar message-xmas-dont-activate-region t
+ "If t, don't activate region after yanking.")
+
+(defvar message-xmas-glyph-directory nil
+ "*Directory where Message logos and icons are located.
+If this variable is nil, Message will try to locate the directory
+automatically.")
+
+(defvar message-use-toolbar (if (featurep 'toolbar)
+ 'default-toolbar
+ nil)
+ "*If nil, do not use a toolbar.
+If it is non-nil, it must be a toolbar. The five legal values are
+`default-toolbar', `top-toolbar', `bottom-toolbar',
+`right-toolbar', and `left-toolbar'.")
+
+(defvar message-toolbar
+ '([message-spell ispell-message t "Spell"]
+ [message-help (Info-goto-node "(Message)Top") t "Message help"])
+ "The message buffer toolbar.")
+
+(defun message-xmas-find-glyph-directory (&optional package)
+ (setq package (or package "message"))
+ (let ((dir (symbol-value
+ (intern-soft (concat package "-xmas-glyph-directory")))))
+ (if (and (stringp dir) (file-directory-p dir))
+ dir
+ (nnheader-find-etc-directory package))))
+
+(defun message-xmas-setup-toolbar (bar &optional force package)
+ (let ((dir (message-xmas-find-glyph-directory package))
+ (xpm (if (featurep 'xpm) "xpm" "xbm"))
+ icon up down disabled name)
+ (unless package
+ (setq message-xmas-glyph-directory dir))
+ (when dir
+ (while bar
+ (setq icon (aref (car bar) 0)
+ name (symbol-name icon)
+ bar (cdr bar))
+ (when (or force
+ (not (boundp icon)))
+ (setq up (concat dir name "-up." xpm))
+ (setq down (concat dir name "-down." xpm))
+ (setq disabled (concat dir name "-disabled." xpm))
+ (if (not (file-exists-p up))
+ (setq bar nil
+ dir nil)
+ (set icon (toolbar-make-button-list
+ up (and (file-exists-p down) down)
+ (and (file-exists-p disabled) disabled)))))))
+ dir))
+
+(defun message-setup-toolbar ()
+ (and message-use-toolbar
+ (message-xmas-setup-toolbar message-toolbar)
+ (set-specifier (symbol-value message-use-toolbar)
+ (cons (current-buffer) message-toolbar))))
+
+(defun message-xmas-exchange-point-and-mark ()
+ "Exchange point and mark, but allow for XEmacs' optional argument."
+ (exchange-point-and-mark message-xmas-dont-activate-region))
+
+(fset 'message-exchange-point-and-mark 'message-xmas-exchange-point-and-mark)
+
+(defun message-xmas-maybe-fontify ()
+ (when (and (featurep 'font-lock)
+ font-lock-auto-fontify)
+ (turn-on-font-lock)))
+
+(defun message-xmas-make-caesar-translation-table (n)
+ "Create a rot table with offset N."
+ (let ((i -1)
+ (table (make-string 256 0))
+ (a (char-int ?a))
+ (A (char-int ?A)))
+ (while (< (incf i) 256)
+ (aset table i i))
+ (concat
+ (substring table 0 A)
+ (substring table (+ A n) (+ A n (- 26 n)))
+ (substring table A (+ A n))
+ (substring table (+ A 26) a)
+ (substring table (+ a n) (+ a n (- 26 n)))
+ (substring table a (+ a n))
+ (substring table (+ a 26) 255))))
+
+(when (>= emacs-major-version 20)
+ (fset 'message-make-caesar-translation-table
+ 'message-xmas-make-caesar-translation-table))
+
+(add-hook 'message-mode-hook 'message-xmas-maybe-fontify)
+
+(provide 'messagexmas)
+
+;;; messagexmas.el ends here
--- /dev/null
+;;; messcompat.el --- making message mode compatible with mail mode
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file tries to provide backward compatability with sendmail.el
+;; for Message mode. It should be used by simply adding
+;;
+;; (require 'messcompat)
+;;
+;; to the .emacs file. Loading it after Message mode has been
+;; loaded will have no effect.
+
+;;; Code:
+
+(require 'sendmail)
+
+(defvar message-from-style mail-from-style
+ "*Specifies how \"From\" headers look.
+
+If `nil', they contain just the return address like:
+ king@grassland.com
+If `parens', they look like:
+ king@grassland.com (Elvis Parsley)
+If `angles', they look like:
+ Elvis Parsley <king@grassland.com>
+
+Otherwise, most addresses look like `angles', but they look like
+`parens' if `angles' would need quoting and `parens' would not.")
+
+(defvar message-interactive mail-interactive
+ "Non-nil means when sending a message wait for and display errors.
+nil means let mailer mail back a message to report errors.")
+
+(defvar message-setup-hook mail-setup-hook
+ "Normal hook, run each time a new outgoing message is initialized.
+The function `message-setup' runs this hook.")
+
+(defvar message-mode-hook mail-mode-hook
+ "Hook run in message mode buffers.")
+
+(defvar message-indentation-spaces mail-indentation-spaces
+ "*Number of spaces to insert at the beginning of each cited line.
+Used by `message-yank-original' via `message-yank-cite'.")
+
+(defvar message-signature mail-signature
+ "*String to be inserted at the end of the message buffer.
+If t, the `message-signature-file' file will be inserted instead.
+If a function, the result from the function will be used instead.
+If a form, the result from the form will be used instead.")
+
+;; Deleted the autoload cookie because this crashes in loaddefs.el.
+(defvar message-signature-file mail-signature-file
+ "*File containing the text inserted at end of message. buffer.")
+
+(defvar message-default-headers mail-default-headers
+ "*A string containing header lines to be inserted in outgoing messages.
+It is inserted before you edit the message, so you can edit or delete
+these lines.")
+
+(defvar message-send-hook mail-send-hook
+ "Hook run before sending messages.")
+
+(provide 'messcompat)
+
+;;; messcompat.el ends here
--- /dev/null
+;;; nnagent.el --- offline backend for Gnus
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnoo)
+(require 'cl)
+(require 'gnus-agent)
+(require 'nnml)
+
+(nnoo-declare nnagent
+ nnml)
+
+\f
+
+(defconst nnagent-version "nnagent 1.0")
+
+(defvoo nnagent-directory nil
+ "Internal variable."
+ nnml-directory)
+
+(defvoo nnagent-active-file nil
+ "Internal variable."
+ nnml-active-file)
+
+(defvoo nnagent-newsgroups-file nil
+ "Internal variable."
+ nnml-newsgroups-file)
+
+(defvoo nnagent-get-new-mail nil
+ "Internal variable."
+ nnml-get-new-mail)
+
+;;; Interface functions.
+
+(nnoo-define-basics nnagent)
+
+(deffoo nnagent-open-server (server &optional defs)
+ (setq defs
+ `((nnagent-directory ,(gnus-agent-directory))
+ (nnagent-active-file ,(gnus-agent-lib-file "active"))
+ (nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups"))
+ (nnagent-get-new-mail nil)))
+ (nnoo-change-server 'nnagent server defs)
+ (let ((dir (gnus-agent-directory))
+ err)
+ (cond
+ ((not (condition-case arg
+ (file-exists-p dir)
+ (ftp-error (setq err (format "%s" arg)))))
+ (nnagent-close-server)
+ (nnheader-report
+ 'nnagent (or err "No such file or directory: %s" dir)))
+ ((not (file-directory-p (file-truename dir)))
+ (nnagent-close-server)
+ (nnheader-report 'nnagent "Not a directory: %s" dir))
+ (t
+ (nnheader-report 'nnagent "Opened server %s using directory %s"
+ server dir)
+ t))))
+
+(deffoo nnagent-retrieve-groups (groups &optional server)
+ (save-excursion
+ (cond
+ ((file-exists-p (gnus-agent-lib-file "groups"))
+ (nnmail-find-file (gnus-agent-lib-file "groups"))
+ 'groups)
+ ((file-exists-p (gnus-agent-lib-file "active"))
+ (nnmail-find-file (gnus-agent-lib-file "active"))
+ 'active)
+ (t nil))))
+
+(defun nnagent-request-type (group article)
+ (let ((gnus-plugged t))
+ (if (not (gnus-check-backend-function
+ 'request-type (car gnus-command-method)))
+ 'unknown
+ (funcall (gnus-get-function gnus-command-method 'request-type)
+ (gnus-group-real-name group) article))))
+
+(deffoo nnagent-request-newgroups (date server)
+ nil)
+
+(deffoo nnagent-request-post (&optional server)
+ (gnus-request-accept-article "nndraft:queue"))
+
+;; Use nnml functions for just about everything.
+(nnoo-import nnagent
+ (nnml))
+
+\f
+;;; Internal functions.
+
+(provide 'nnagent)
+
+;;; nnagent.el ends here
--- /dev/null
+;;; nnbabyl.el --- rmail mbox access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.
+
+;;; Code:
+
+(require 'nnheader)
+(require 'rmail)
+(require 'nnmail)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nnbabyl)
+
+(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL")
+ "The name of the rmail box file in the users home directory.")
+
+(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
+ "The name of the active file for the rmail box.")
+
+(defvoo nnbabyl-get-new-mail t
+ "If non-nil, nnbabyl will check the incoming mail file and split the mail.")
+
+(defvoo nnbabyl-prepare-save-mail-hook nil
+ "Hook run narrowed to an article before saving.")
+
+\f
+
+(defvar nnbabyl-mail-delimiter "\^_")
+
+(defconst nnbabyl-version "nnbabyl 1.0"
+ "nnbabyl version.")
+
+(defvoo nnbabyl-mbox-buffer nil)
+(defvoo nnbabyl-current-group nil)
+(defvoo nnbabyl-status-string "")
+(defvoo nnbabyl-group-alist nil)
+(defvoo nnbabyl-active-timestamp nil)
+
+(defvoo nnbabyl-previous-buffer-mode nil)
+
+(eval-and-compile
+ (autoload 'gnus-set-text-properties "gnus-ems"))
+
+\f
+
+;;; Interface functions
+
+(nnoo-define-basics nnbabyl)
+
+(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let ((number (length articles))
+ (count 0)
+ (delim (concat "^" nnbabyl-mail-delimiter))
+ article art-string start stop)
+ (nnbabyl-possibly-change-newsgroup group server)
+ (while (setq article (pop articles))
+ (setq art-string (nnbabyl-article-string article))
+ (set-buffer nnbabyl-mbox-buffer)
+ (end-of-line)
+ (when (or (search-forward art-string nil t)
+ (search-backward art-string nil t))
+ (unless (re-search-backward delim nil t)
+ (goto-char (point-min)))
+ (while (and (not (looking-at ".+:"))
+ (zerop (forward-line 1))))
+ (setq start (point))
+ (search-forward "\n\n" nil t)
+ (setq stop (1- (point)))
+ (set-buffer nntp-server-buffer)
+ (insert "221 ")
+ (princ article (current-buffer))
+ (insert " Article retrieved.\n")
+ (insert-buffer-substring nnbabyl-mbox-buffer start stop)
+ (goto-char (point-max))
+ (insert ".\n"))
+ (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)
+ (zerop (% (incf count) 20))
+ (nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
+ (/ (* count 100) number))))
+
+ (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)
+ (nnheader-message 5 "nnbabyl: Receiving headers...done"))
+
+ (set-buffer nntp-server-buffer)
+ (nnheader-fold-continuation-lines)
+ 'headers)))
+
+(deffoo nnbabyl-open-server (server &optional defs)
+ (nnoo-change-server 'nnbabyl server defs)
+ (nnbabyl-create-mbox)
+ (cond
+ ((not (file-exists-p nnbabyl-mbox-file))
+ (nnbabyl-close-server)
+ (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file))
+ ((file-directory-p nnbabyl-mbox-file)
+ (nnbabyl-close-server)
+ (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file))
+ (t
+ (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server
+ nnbabyl-mbox-file)
+ t)))
+
+(deffoo nnbabyl-close-server (&optional server)
+ ;; Restore buffer mode.
+ (when (and (nnbabyl-server-opened)
+ nnbabyl-previous-buffer-mode)
+ (save-excursion
+ (set-buffer nnbabyl-mbox-buffer)
+ (narrow-to-region
+ (caar nnbabyl-previous-buffer-mode)
+ (cdar nnbabyl-previous-buffer-mode))
+ (funcall (cdr nnbabyl-previous-buffer-mode))))
+ (nnoo-close-server 'nnbabyl server)
+ (setq nnbabyl-mbox-buffer nil)
+ t)
+
+(deffoo nnbabyl-server-opened (&optional server)
+ (and (nnoo-current-server-p 'nnbabyl server)
+ nnbabyl-mbox-buffer
+ (buffer-name nnbabyl-mbox-buffer)
+ nntp-server-buffer
+ (buffer-name nntp-server-buffer)))
+
+(deffoo nnbabyl-request-article (article &optional newsgroup server buffer)
+ (nnbabyl-possibly-change-newsgroup newsgroup server)
+ (save-excursion
+ (set-buffer nnbabyl-mbox-buffer)
+ (goto-char (point-min))
+ (when (search-forward (nnbabyl-article-string article) nil t)
+ (let (start stop summary-line)
+ (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+ (goto-char (point-min))
+ (end-of-line))
+ (while (and (not (looking-at ".+:"))
+ (zerop (forward-line 1))))
+ (setq start (point))
+ (or (when (re-search-forward
+ (concat "^" nnbabyl-mail-delimiter) nil t)
+ (beginning-of-line)
+ t)
+ (goto-char (point-max)))
+ (setq stop (point))
+ (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring nnbabyl-mbox-buffer start stop)
+ (goto-char (point-min))
+ ;; If there is an EOOH header, then we have to remove some
+ ;; duplicated headers.
+ (setq summary-line (looking-at "Summary-line:"))
+ (when (search-forward "\n*** EOOH ***" nil t)
+ (if summary-line
+ ;; The headers to be deleted are located before the
+ ;; EOOH line...
+ (delete-region (point-min) (progn (forward-line 1)
+ (point)))
+ ;; ...or after.
+ (delete-region (progn (beginning-of-line) (point))
+ (or (search-forward "\n\n" nil t)
+ (point)))))
+ (if (numberp article)
+ (cons nnbabyl-current-group article)
+ (nnbabyl-article-group-number)))))))
+
+(deffoo nnbabyl-request-group (group &optional server dont-check)
+ (let ((active (cadr (assoc group nnbabyl-group-alist))))
+ (save-excursion
+ (cond
+ ((or (null active)
+ (null (nnbabyl-possibly-change-newsgroup group server)))
+ (nnheader-report 'nnbabyl "No such group: %s" group))
+ (dont-check
+ (nnheader-report 'nnbabyl "Selected group %s" group)
+ (nnheader-insert ""))
+ (t
+ (nnheader-report 'nnbabyl "Selected group %s" group)
+ (nnheader-insert "211 %d %d %d %s\n"
+ (1+ (- (cdr active) (car active)))
+ (car active) (cdr active) group))))))
+
+(deffoo nnbabyl-request-scan (&optional group server)
+ (nnbabyl-possibly-change-newsgroup group server)
+ (nnbabyl-read-mbox)
+ (nnmail-get-new-mail
+ 'nnbabyl
+ (lambda ()
+ (save-excursion
+ (set-buffer nnbabyl-mbox-buffer)
+ (save-buffer)))
+ (file-name-directory nnbabyl-mbox-file)
+ group
+ (lambda ()
+ (save-excursion
+ (let ((in-buf (current-buffer)))
+ (goto-char (point-min))
+ (while (search-forward "\n\^_\n" nil t)
+ (delete-char -1))
+ (set-buffer nnbabyl-mbox-buffer)
+ (goto-char (point-max))
+ (search-backward "\n\^_" nil t)
+ (goto-char (match-end 0))
+ (insert-buffer-substring in-buf)))
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))
+
+(deffoo nnbabyl-close-group (group &optional server)
+ t)
+
+(deffoo nnbabyl-request-create-group (group &optional server args)
+ (nnmail-activate 'nnbabyl)
+ (unless (assoc group nnbabyl-group-alist)
+ (push (list group (cons 1 0))
+ nnbabyl-group-alist)
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
+ t)
+
+(deffoo nnbabyl-request-list (&optional server)
+ (save-excursion
+ (nnmail-find-file nnbabyl-active-file)
+ (setq nnbabyl-group-alist (nnmail-get-active))
+ t))
+
+(deffoo nnbabyl-request-newgroups (date &optional server)
+ (nnbabyl-request-list server))
+
+(deffoo nnbabyl-request-list-newsgroups (&optional server)
+ (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))
+
+(deffoo nnbabyl-request-expire-articles
+ (articles newsgroup &optional server force)
+ (nnbabyl-possibly-change-newsgroup newsgroup server)
+ (let* ((is-old t)
+ rest)
+ (nnmail-activate 'nnbabyl)
+
+ (save-excursion
+ (set-buffer nnbabyl-mbox-buffer)
+ (gnus-set-text-properties (point-min) (point-max) nil)
+ (while (and articles is-old)
+ (goto-char (point-min))
+ (when (search-forward (nnbabyl-article-string (car articles)) nil t)
+ (if (setq is-old
+ (nnmail-expired-article-p
+ newsgroup
+ (buffer-substring
+ (point) (progn (end-of-line) (point))) force))
+ (progn
+ (nnheader-message 5 "Deleting article %d in %s..."
+ (car articles) newsgroup)
+ (nnbabyl-delete-mail))
+ (push (car articles) rest)))
+ (setq articles (cdr articles)))
+ (save-buffer)
+ ;; Find the lowest active article in this group.
+ (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist))))
+ (goto-char (point-min))
+ (while (and (not (search-forward
+ (nnbabyl-article-string (car active)) nil t))
+ (<= (car active) (cdr active)))
+ (setcar active (1+ (car active)))
+ (goto-char (point-min))))
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
+ (nconc rest articles))))
+
+(deffoo nnbabyl-request-move-article
+ (article group server accept-form &optional last)
+ (let ((buf (get-buffer-create " *nnbabyl move*"))
+ result)
+ (and
+ (nnbabyl-request-article article group server)
+ (save-excursion
+ (set-buffer buf)
+ (insert-buffer-substring nntp-server-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^X-Gnus-Newsgroup:"
+ (save-excursion (search-forward "\n\n" nil t) (point)) t)
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ (setq result (eval accept-form))
+ (kill-buffer (current-buffer))
+ result)
+ (save-excursion
+ (nnbabyl-possibly-change-newsgroup group server)
+ (set-buffer nnbabyl-mbox-buffer)
+ (goto-char (point-min))
+ (if (search-forward (nnbabyl-article-string article) nil t)
+ (nnbabyl-delete-mail))
+ (and last (save-buffer))))
+ result))
+
+(deffoo nnbabyl-request-accept-article (group &optional server last)
+ (nnbabyl-possibly-change-newsgroup group server)
+ (nnmail-check-syntax)
+ (let ((buf (current-buffer))
+ result beg)
+ (and
+ (nnmail-activate 'nnbabyl)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (forward-line -1)
+ (save-excursion
+ (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
+ (delete-region (point) (progn (forward-line 1) (point)))))
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (setq result
+ (if (stringp group)
+ (list (cons group (nnbabyl-active-number group)))
+ (nnmail-article-group 'nnbabyl-active-number)))
+ (if (and (null result)
+ (yes-or-no-p "Moved to `junk' group; delete article? "))
+ (setq result 'junk)
+ (setq result (car (nnbabyl-save-mail result))))
+ (set-buffer nnbabyl-mbox-buffer)
+ (goto-char (point-max))
+ (search-backward "\n\^_")
+ (goto-char (match-end 0))
+ (insert-buffer-substring buf)
+ (when last
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (save-buffer)
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
+ result))))
+
+(deffoo nnbabyl-request-replace-article (article group buffer)
+ (nnbabyl-possibly-change-newsgroup group)
+ (save-excursion
+ (set-buffer nnbabyl-mbox-buffer)
+ (goto-char (point-min))
+ (if (not (search-forward (nnbabyl-article-string article) nil t))
+ nil
+ (nnbabyl-delete-mail t t)
+ (insert-buffer-substring buffer)
+ (save-buffer)
+ t)))
+
+(deffoo nnbabyl-request-delete-group (group &optional force server)
+ (nnbabyl-possibly-change-newsgroup group server)
+ ;; Delete all articles in GROUP.
+ (if (not force)
+ () ; Don't delete the articles.
+ (save-excursion
+ (set-buffer nnbabyl-mbox-buffer)
+ (goto-char (point-min))
+ ;; Delete all articles in this group.
+ (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
+ found)
+ (while (search-forward ident nil t)
+ (setq found t)
+ (nnbabyl-delete-mail))
+ (when found
+ (save-buffer)))))
+ ;; Remove the group from all structures.
+ (setq nnbabyl-group-alist
+ (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist)
+ nnbabyl-current-group nil)
+ ;; Save the active file.
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
+ t)
+
+(deffoo nnbabyl-request-rename-group (group new-name &optional server)
+ (nnbabyl-possibly-change-newsgroup group server)
+ (save-excursion
+ (set-buffer nnbabyl-mbox-buffer)
+ (goto-char (point-min))
+ (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
+ (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
+ found)
+ (while (search-forward ident nil t)
+ (replace-match new-ident t t)
+ (setq found t))
+ (when found
+ (save-buffer))))
+ (let ((entry (assoc group nnbabyl-group-alist)))
+ (and entry (setcar entry new-name))
+ (setq nnbabyl-current-group nil)
+ ;; Save the new group alist.
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
+ t))
+
+\f
+;;; Internal functions.
+
+;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
+;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
+;; delimiter line.
+(defun nnbabyl-delete-mail (&optional force leave-delim)
+ ;; Delete the current X-Gnus-Newsgroup line.
+ (unless force
+ (delete-region
+ (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ ;; Beginning of the article.
+ (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region
+ (save-excursion
+ (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+ (goto-char (point-min))
+ (end-of-line))
+ (if leave-delim (progn (forward-line 1) (point))
+ (match-beginning 0)))
+ (progn
+ (forward-line 1)
+ (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter)
+ nil t)
+ (match-beginning 0))
+ (point-max))))
+ (goto-char (point-min))
+ ;; Only delete the article if no other groups owns it as well.
+ (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
+ (delete-region (point-min) (point-max))))))
+
+(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server)
+ (when (and server
+ (not (nnbabyl-server-opened server)))
+ (nnbabyl-open-server server))
+ (when (or (not nnbabyl-mbox-buffer)
+ (not (buffer-name nnbabyl-mbox-buffer)))
+ (save-excursion (nnbabyl-read-mbox)))
+ (unless nnbabyl-group-alist
+ (nnmail-activate 'nnbabyl))
+ (if newsgroup
+ (if (assoc newsgroup nnbabyl-group-alist)
+ (setq nnbabyl-current-group newsgroup)
+ (nnheader-report 'nnbabyl "No such group in file"))
+ t))
+
+(defun nnbabyl-article-string (article)
+ (if (numberp article)
+ (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"
+ (int-to-string article) " ")
+ (concat "\nMessage-ID: " article)))
+
+(defun nnbabyl-article-group-number ()
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
+ nil t)
+ (cons (buffer-substring (match-beginning 1) (match-end 1))
+ (string-to-int
+ (buffer-substring (match-beginning 2) (match-end 2)))))))
+
+(defun nnbabyl-insert-lines ()
+ "Insert how many lines and chars there are in the body of the mail."
+ (let (lines chars)
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ ;; There may be an EOOH line here...
+ (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
+ (search-forward "\n\n" nil t))
+ (setq chars (- (point-max) (point))
+ lines (max (- (count-lines (point) (point-max)) 1) 0))
+ ;; Move back to the end of the headers.
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (save-excursion
+ (when (re-search-backward "^Lines: " nil t)
+ (delete-region (point) (progn (forward-line 1) (point)))))
+ (insert (format "Lines: %d\n" lines))
+ chars))))
+
+(defun nnbabyl-save-mail (group-art)
+ ;; Called narrowed to an article.
+ (nnbabyl-insert-lines)
+ (nnmail-insert-xref group-art)
+ (nnbabyl-insert-newsgroup-line group-art)
+ (run-hooks 'nnbabyl-prepare-save-mail-hook)
+ group-art)
+
+(defun nnbabyl-insert-newsgroup-line (group-art)
+ (save-excursion
+ (goto-char (point-min))
+ (while (looking-at "From ")
+ (replace-match "Mail-from: From " t t)
+ (forward-line 1))
+ ;; If there is a C-l at the beginning of the narrowed region, this
+ ;; isn't really a "save", but rather a "scan".
+ (goto-char (point-min))
+ (unless (looking-at "\^L")
+ (save-excursion
+ (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
+ (goto-char (point-max))
+ (insert "\^_\n")))
+ (when (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (while group-art
+ (insert (format "X-Gnus-Newsgroup: %s:%d %s\n"
+ (caar group-art) (cdar group-art)
+ (current-time-string)))
+ (setq group-art (cdr group-art))))
+ t))
+
+(defun nnbabyl-active-number (group)
+ ;; Find the next article number in GROUP.
+ (let ((active (cadr (assoc group nnbabyl-group-alist))))
+ (if active
+ (setcdr active (1+ (cdr active)))
+ ;; This group is new, so we create a new entry for it.
+ ;; This might be a bit naughty... creating groups on the drop of
+ ;; a hat, but I don't know...
+ (push (list group (setq active (cons 1 1)))
+ nnbabyl-group-alist))
+ (cdr active)))
+
+(defun nnbabyl-create-mbox ()
+ (unless (file-exists-p nnbabyl-mbox-file)
+ ;; Create a new, empty RMAIL mbox file.
+ (save-excursion
+ (set-buffer (setq nnbabyl-mbox-buffer
+ (create-file-buffer nnbabyl-mbox-file)))
+ (setq buffer-file-name nnbabyl-mbox-file)
+ (insert "BABYL OPTIONS:\n\n\^_")
+ (nnmail-write-region
+ (point-min) (point-max) nnbabyl-mbox-file t 'nomesg))))
+
+(defun nnbabyl-read-mbox ()
+ (nnmail-activate 'nnbabyl)
+ (nnbabyl-create-mbox)
+
+ (unless (and nnbabyl-mbox-buffer
+ (buffer-name nnbabyl-mbox-buffer)
+ (save-excursion
+ (set-buffer nnbabyl-mbox-buffer)
+ (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
+ ;; This buffer has changed since we read it last. Possibly.
+ (save-excursion
+ (let ((delim (concat "^" nnbabyl-mail-delimiter))
+ (alist nnbabyl-group-alist)
+ start end number)
+ (set-buffer (setq nnbabyl-mbox-buffer
+ (nnheader-find-file-noselect
+ nnbabyl-mbox-file nil 'raw)))
+ ;; Save previous buffer mode.
+ (setq nnbabyl-previous-buffer-mode
+ (cons (cons (point-min) (point-max))
+ major-mode))
+
+ (buffer-disable-undo (current-buffer))
+ (widen)
+ (setq buffer-read-only nil)
+ (fundamental-mode)
+
+ ;; Go through the group alist and compare against
+ ;; the rmail file.
+ (while alist
+ (goto-char (point-max))
+ (when (and (re-search-backward
+ (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
+ (caar alist))
+ nil t)
+ (> (setq number
+ (string-to-number
+ (buffer-substring
+ (match-beginning 1) (match-end 1))))
+ (cdadar alist)))
+ (setcdr (cadar alist) number))
+ (setq alist (cdr alist)))
+
+ ;; We go through the mbox and make sure that each and
+ ;; every mail belongs to some group or other.
+ (goto-char (point-min))
+ (if (looking-at "\^L")
+ (setq start (point))
+ (re-search-forward delim nil t)
+ (setq start (match-end 0)))
+ (while (re-search-forward delim nil t)
+ (setq end (match-end 0))
+ (unless (search-backward "\nX-Gnus-Newsgroup: " start t)
+ (goto-char end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (goto-char start) end)
+ (nnbabyl-save-mail
+ (nnmail-article-group 'nnbabyl-active-number))
+ (setq end (point-max)))))
+ (goto-char (setq start end)))
+ (when (buffer-modified-p (current-buffer))
+ (save-buffer))
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))
+
+(defun nnbabyl-remove-incoming-delims ()
+ (goto-char (point-min))
+ (while (search-forward "\^_" nil t)
+ (replace-match "?" t t)))
+
+(defun nnbabyl-check-mbox ()
+ "Go through the nnbabyl mbox and make sure that no article numbers are reused."
+ (interactive)
+ (let ((idents (make-vector 1000 0))
+ id)
+ (save-excursion
+ (when (or (not nnbabyl-mbox-buffer)
+ (not (buffer-name nnbabyl-mbox-buffer)))
+ (nnbabyl-read-mbox))
+ (set-buffer nnbabyl-mbox-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t)
+ (if (intern-soft (setq id (match-string 1)) idents)
+ (progn
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point)))
+ (nnheader-message 7 "Moving %s..." id)
+ (nnbabyl-save-mail
+ (nnmail-article-group 'nnbabyl-active-number)))
+ (intern id idents)))
+ (when (buffer-modified-p (current-buffer))
+ (save-buffer))
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
+ (message ""))))
+
+(provide 'nnbabyl)
+
+;;; nnbabyl.el ends here
--- /dev/null
+;;; nndb.el --- nndb access for Gnus
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
+;; Joe Hildebrand <joe.hildebrand@ilg.com>
+;; David Blacka <davidb@rwhois.net>
+;; Keywords: news
+
+;; 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This was based upon Kai Grossjohan's shamessly snarfed code and
+;;; further modified by Joe Hildebrand. It has been updated for Red
+;;; Gnus.
+
+;; TODO:
+;;
+;; * Fix bug where server connection can be lost and impossible to regain
+;; This hasn't happened to me in a while; think it was fixed in Rgnus
+;;
+;; * make it handle different nndb servers seemlessly
+;;
+;; * Optimize expire if FORCE
+;;
+;; * Optimize move (only expire once)
+;;
+;; * Deal with add/deletion of groups
+;;
+;; * make the backend TOUCH an article when marked as expireable (will
+;; make article expire 'expiry' days after that moment).
+
+;;-
+;; Register nndb with known select methods.
+
+(gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)
+
+;;; Code:
+
+(require 'nnmail)
+(require 'nnheader)
+(require 'nntp)
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+ (unless (fboundp 'open-network-stream)
+ (require 'tcp)))
+
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+ (autoload 'news-setup "rnewspost")
+ (autoload 'news-reply-mode "rnewspost")
+ (autoload 'cancel-timer "timer")
+ (autoload 'telnet "telnet" nil t)
+ (autoload 'telnet-send-input "telnet" nil t)
+ (autoload 'timezone-parse-date "timezone"))
+
+;; Declare nndb as derived from nntp
+
+(nnoo-declare nndb nntp)
+
+;; Variables specific to nndb
+
+;;- currently not used but just in case...
+(defvoo nndb-deliver-program "nndel"
+ "*The program used to put a message in an NNDB group.")
+
+(defvoo nndb-server-side-expiry nil
+ "If t, expiry calculation will occur on the server side")
+
+(defvoo nndb-set-expire-date-on-mark nil
+ "If t, the expiry date for a given article will be set to the time
+it was marked as expireable; otherwise the date will be the time the
+article was posted to nndb")
+
+;; Variables copied from nntp
+
+(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
+ "Like nntp-server-opened-hook."
+ nntp-server-opened-hook)
+
+(defvoo nndb-address "localhost"
+ "*The name of the NNDB server."
+ nntp-address)
+
+(defvoo nndb-port-number 9000
+ "*Port number to connect to."
+ nntp-port-number)
+
+;; change to 'news if you are actually using nndb for news
+(defvoo nndb-article-type 'mail)
+
+(defvoo nndb-status-string nil "" nntp-status-string)
+
+\f
+
+(defconst nndb-version "nndb 0.7"
+ "Version numbers of this version of NNDB.")
+
+\f
+;;; Interface functions.
+
+(nnoo-define-basics nndb)
+
+;;------------------------------------------------------------------
+
+;; this function turns the lisp list into a string list. There is
+;; probably a more efficient way to do this.
+(defun nndb-build-article-string (articles)
+ (let (art-string art)
+ (while articles
+ (setq art (pop articles))
+ (setq art-string (concat art-string art " ")))
+ art-string))
+
+(defun nndb-build-expire-rest-list (total expire)
+ (let (art rest)
+ (while total
+ (setq art (pop total))
+ (if (memq art expire)
+ ()
+ (push art rest)))
+ rest))
+
+
+;;
+(deffoo nndb-request-type (group &optional article)
+ nndb-article-type)
+
+;; nndb-request-update-info does not exist and is not needed
+
+;; nndb-request-update-mark does not exist; it should be used to TOUCH
+;; articles as they are marked exipirable
+(defun nndb-touch-article (group article)
+ (nntp-send-command nil "X-TOUCH" article))
+
+(deffoo nndb-request-update-mark
+ (group article mark)
+ "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
+ (if (and nndb-set-expire-date-on-mark (string-equal mark "E"))
+ (nndb-touch-article group article))
+ mark)
+
+;; nndb-request-create-group -- currently this isn't necessary; nndb
+;; creates groups on demand.
+
+;; todo -- use some other time than the creation time of the article
+;; best is time since article has been marked as expirable
+
+(defun nndb-request-expire-articles-local
+ (articles &optional group server force)
+ "Let gnus do the date check and issue the delete commands."
+ (let (msg art delete-list (num-delete 0) rest)
+ (nntp-possibly-change-group group server)
+ (while articles
+ (setq art (pop articles))
+ (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art)
+ (setq msg (nndb-status-message))
+ (if (string-match "^423" msg)
+ ()
+ (or (string-match "'\\(.+\\)'" msg)
+ (error "Not a valid response for X-DATE command: %s"
+ msg))
+ (if (nnmail-expired-article-p
+ group
+ (gnus-encode-date
+ (substring msg (match-beginning 1) (match-end 1)))
+ force)
+ (progn
+ (setq delete-list (concat delete-list " " (int-to-string art)))
+ (setq num-delete (1+ num-delete)))
+ (push art rest))))
+ (if (> (length delete-list) 0)
+ (progn
+ (nnheader-message 5 "Deleting %s article(s) from %s"
+ (int-to-string num-delete) group)
+ (nntp-send-command "^[23].*\n" "X-DELETE" delete-list))
+ )
+
+ (message "")
+ (nconc rest articles)))
+
+(defun nndb-get-remote-expire-response ()
+ (let (list)
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (if (looking-at "^[34]")
+ ;; x-expire returned error--presume no articles were expirable)
+ (setq list nil)
+ ;; otherwise, pull all of the following numbers into the list
+ (re-search-forward "follows\r?\n?" nil t)
+ (while (re-search-forward "^[0-9]+$" nil t)
+ (push (string-to-int (match-string 0)) list)))
+ list))
+
+(defun nndb-request-expire-articles-remote
+ (articles &optional group server force)
+ "Let the nndb backend expire articles"
+ (let (days art-string delete-list (num-delete 0))
+ (nntp-possibly-change-group group server)
+
+ ;; first calculate the wait period in days
+ (setq days (or (and nnmail-expiry-wait-function
+ (funcall nnmail-expiry-wait-function group))
+ nnmail-expiry-wait))
+ ;; now handle the special cases
+ (cond (force
+ (setq days 0))
+ ((eq days 'never)
+ ;; This isn't an expirable group.
+ (setq days -1))
+ ((eq days 'immediate)
+ (setq days 0)))
+
+
+ ;; build article string
+ (setq art-string (concat days " " (nndb-build-article-string articles)))
+ (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string)
+
+ (setq delete-list (nndb-get-remote-expire-response))
+ (setq num-delete (length delete-list))
+ (if (> num-delete 0)
+ (nnheader-message 5 "Deleting %s article(s) from %s"
+ (int-to-string num-delete) group))
+
+ (nndb-build-expire-rest-list articles delete-list)))
+
+(deffoo nndb-request-expire-articles
+ (articles &optional group server force)
+ "Expires ARTICLES from GROUP on SERVER.
+If FORCE, delete regardless of exiration date, otherwise use normal
+expiry mechanism."
+ (if nndb-server-side-expiry
+ (nndb-request-expire-articles-remote articles group server force)
+ (nndb-request-expire-articles-local articles group server force)))
+
+(deffoo nndb-request-move-article
+ (article group server accept-form &optional last)
+ "Move ARTICLE (a number) from GROUP on SERVER.
+Evals ACCEPT-FORM in current buffer, where the article is.
+Optional LAST is ignored."
+ ;; we guess that the second arg in accept-form is the new group,
+ ;; which it will be for nndb, which is all that matters anyway
+ (let ((new-group (nth 1 accept-form)) result)
+ (nntp-possibly-change-group group server)
+
+ ;; use the move command for nndb-to-nndb moves
+ (if (string-match "^nndb" new-group)
+ (let ((new-group-name (gnus-group-real-name new-group)))
+ (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name)
+ (cons new-group article))
+ ;; else move normally
+ (let ((artbuf (get-buffer-create " *nndb move*")))
+ (and
+ (nndb-request-article article group server artbuf)
+ (save-excursion
+ (set-buffer artbuf)
+ (insert-buffer-substring nntp-server-buffer)
+ (setq result (eval accept-form))
+ (kill-buffer (current-buffer))
+ result)
+ (nndb-request-expire-articles (list article)
+ group
+ server
+ t))
+ result)
+ )))
+
+(deffoo nndb-request-accept-article (group server &optional last)
+ "The article in the current buffer is put into GROUP."
+ (nntp-possibly-change-group group server)
+ (let (art msg)
+ (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
+ (nnheader-insert "")
+ (nntp-send-buffer "^[23].*\n"))
+
+ (set-buffer nntp-server-buffer)
+ (setq msg (buffer-string (point-min) (point-max)))
+ (or (string-match "^\\([0-9]+\\)" msg)
+ (error "nndb: %s" msg))
+ (setq art (substring msg (match-beginning 1) (match-end 1)))
+ (message "nndb: accepted %s" art)
+ (list art)))
+
+(deffoo nndb-request-replace-article (article group buffer)
+ "ARTICLE is the number of the article in GROUP to be replaced
+with the contents of the BUFFER."
+ (set-buffer buffer)
+ (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article))
+ (nnheader-insert "")
+ (nntp-send-buffer "^[23.*\n")
+ (list (int-to-string article))))
+
+; nndb-request-delete-group does not exist
+; todo -- maybe later
+
+; nndb-request-rename-group does not exist
+; todo -- maybe later
+
+;; -- standard compatability functions
+
+(deffoo nndb-status-message (&optional server)
+ "Return server status as a string."
+ (set-buffer nntp-server-buffer)
+ (buffer-string (point-min) (point-max)))
+
+;; Import stuff from nntp
+
+(nnoo-import nndb
+ (nntp))
+
+(provide 'nndb)
+
+
+
--- /dev/null
+;;; nndir.el --- single directory newsgroup access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmh)
+(require 'nnml)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nndir
+ nnml nnmh)
+
+(defvoo nndir-directory nil
+ "Where nndir will look for groups."
+ nnml-current-directory nnmh-current-directory)
+
+(defvoo nndir-nov-is-evil nil
+ "*Non-nil means that nndir will never retrieve NOV headers."
+ nnml-nov-is-evil)
+
+\f
+
+(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group)
+(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory)
+(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail)
+
+(defvoo nndir-status-string "" nil nnmh-status-string)
+(defconst nndir-version "nndir 1.0")
+
+\f
+
+;;; Interface functions.
+
+(nnoo-define-basics nndir)
+
+(deffoo nndir-open-server (server &optional defs)
+ (setq nndir-directory
+ (or (cadr (assq 'nndir-directory defs))
+ server))
+ (unless (assq 'nndir-directory defs)
+ (push `(nndir-directory ,server) defs))
+ (push `(nndir-current-group
+ ,(file-name-nondirectory (directory-file-name nndir-directory)))
+ defs)
+ (push `(nndir-top-directory
+ ,(file-name-directory (directory-file-name nndir-directory)))
+ defs)
+ (nnoo-change-server 'nndir server defs)
+ (let (err)
+ (cond
+ ((not (condition-case arg
+ (file-exists-p nndir-directory)
+ (ftp-error (setq err (format "%s" arg)))))
+ (nndir-close-server)
+ (nnheader-report
+ 'nndir (or err "No such file or directory: %s" nndir-directory)))
+ ((not (file-directory-p (file-truename nndir-directory)))
+ (nndir-close-server)
+ (nnheader-report 'nndir "Not a directory: %s" nndir-directory))
+ (t
+ (nnheader-report 'nndir "Opened server %s using directory %s"
+ server nndir-directory)
+ t))))
+
+(nnoo-map-functions nndir
+ (nnml-retrieve-headers 0 nndir-current-group 0 0)
+ (nnmh-request-article 0 nndir-current-group 0 0)
+ (nnmh-request-group nndir-current-group 0 0)
+ (nnml-close-group nndir-current-group 0)
+ (nnmh-request-list (nnoo-current-server 'nndir) nndir-directory)
+ (nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory))
+
+(provide 'nndir)
+
+;;; nndir.el ends here
--- /dev/null
+;;; nndoc.el --- single file access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'message)
+(require 'nnmail)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nndoc)
+
+(defvoo nndoc-article-type 'guess
+ "*Type of the file.
+One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
+`rfc934', `rfc822-forward', `mime-digest', `standard-digest',
+`slack-digest', `clari-briefs' or `guess'.")
+
+(defvoo nndoc-post-type 'mail
+ "*Whether the nndoc group is `mail' or `post'.")
+
+(defvar nndoc-type-alist
+ `((mmdf
+ (article-begin . "^\^A\^A\^A\^A\n")
+ (body-end . "^\^A\^A\^A\^A\n"))
+ (news
+ (article-begin . "^Path:"))
+ (rnews
+ (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
+ (body-end-function . nndoc-rnews-body-end))
+ (mbox
+ (article-begin-function . nndoc-mbox-article-begin)
+ (body-end-function . nndoc-mbox-body-end))
+ (babyl
+ (article-begin . "\^_\^L *\n")
+ (body-end . "\^_")
+ (body-begin-function . nndoc-babyl-body-begin)
+ (head-begin-function . nndoc-babyl-head-begin))
+ (forward
+ (article-begin . "^-+ Start of forwarded message -+\n+")
+ (body-end . "^-+ End of forwarded message -+$")
+ (prepare-body-function . nndoc-unquote-dashes))
+ (rfc934
+ (article-begin . "^--.*\n+")
+ (body-end . "^--.*$")
+ (prepare-body-function . nndoc-unquote-dashes))
+ (clari-briefs
+ (article-begin . "^ \\*")
+ (body-end . "^\t------*[ \t]^*\n^ \\*")
+ (body-begin . "^\t")
+ (head-end . "^\t")
+ (generate-head-function . nndoc-generate-clari-briefs-head)
+ (article-transform-function . nndoc-transform-clari-briefs))
+ (mime-digest
+ (article-begin . "")
+ (head-end . "^ ?$")
+ (body-end . "")
+ (file-end . "")
+ (subtype digest guess))
+ (standard-digest
+ (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+"))
+ (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n\n+"))
+ (prepare-body-function . nndoc-unquote-dashes)
+ (body-end-function . nndoc-digest-body-end)
+ (head-end . "^ ?$")
+ (body-begin . "^ ?\n")
+ (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
+ (subtype digest guess))
+ (slack-digest
+ (article-begin . "^------------------------------*[\n \t]+")
+ (head-end . "^ ?$")
+ (body-end-function . nndoc-digest-body-end)
+ (body-begin . "^ ?$")
+ (file-end . "^End of")
+ (prepare-body-function . nndoc-unquote-dashes)
+ (subtype digest guess))
+ (lanl-gov-announce
+ (article-begin . "^\\\\\\\\\n")
+ (head-begin . "^Paper.*:")
+ (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
+ (body-begin . "")
+ (body-end . "-------------------------------------------------")
+ (file-end . "^Title: Recent Seminal")
+ (generate-head-function . nndoc-generate-lanl-gov-head)
+ (article-transform-function . nndoc-transform-lanl-gov-announce)
+ (subtype preprints guess))
+ (rfc822-forward
+ (article-begin . "^\n")
+ (body-end-function . nndoc-rfc822-forward-body-end-function))
+ (guess
+ (guess . t)
+ (subtype nil))
+ (digest
+ (guess . t)
+ (subtype nil))
+ (preprints
+ (guess . t)
+ (subtype nil))))
+
+\f
+
+(defvoo nndoc-file-begin nil)
+(defvoo nndoc-first-article nil)
+(defvoo nndoc-article-end nil)
+(defvoo nndoc-article-begin nil)
+(defvoo nndoc-head-begin nil)
+(defvoo nndoc-head-end nil)
+(defvoo nndoc-file-end nil)
+(defvoo nndoc-body-begin nil)
+(defvoo nndoc-body-end-function nil)
+(defvoo nndoc-body-begin-function nil)
+(defvoo nndoc-head-begin-function nil)
+(defvoo nndoc-body-end nil)
+(defvoo nndoc-dissection-alist nil)
+(defvoo nndoc-prepare-body-function nil)
+(defvoo nndoc-generate-head-function nil)
+(defvoo nndoc-article-transform-function nil)
+(defvoo nndoc-article-begin-function nil)
+
+(defvoo nndoc-status-string "")
+(defvoo nndoc-group-alist nil)
+(defvoo nndoc-current-buffer nil
+ "Current nndoc news buffer.")
+(defvoo nndoc-address nil)
+
+(defconst nndoc-version "nndoc 1.0"
+ "nndoc version.")
+
+\f
+
+;;; Interface functions
+
+(nnoo-define-basics nndoc)
+
+(deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
+ (when (nndoc-possibly-change-buffer newsgroup server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let (article entry)
+ (if (stringp (car articles))
+ 'headers
+ (while articles
+ (when (setq entry (cdr (assq (setq article (pop articles))
+ nndoc-dissection-alist)))
+ (insert (format "221 %d Article retrieved.\n" article))
+ (if nndoc-generate-head-function
+ (funcall nndoc-generate-head-function article)
+ (insert-buffer-substring
+ nndoc-current-buffer (car entry) (nth 1 entry)))
+ (goto-char (point-max))
+ (unless (= (char-after (1- (point))) ?\n)
+ (insert "\n"))
+ (insert (format "Lines: %d\n" (nth 4 entry)))
+ (insert ".\n")))
+
+ (nnheader-fold-continuation-lines)
+ 'headers)))))
+
+(deffoo nndoc-request-article (article &optional newsgroup server buffer)
+ (nndoc-possibly-change-buffer newsgroup server)
+ (save-excursion
+ (let ((buffer (or buffer nntp-server-buffer))
+ (entry (cdr (assq article nndoc-dissection-alist)))
+ beg)
+ (set-buffer buffer)
+ (erase-buffer)
+ (when entry
+ (if (stringp article)
+ nil
+ (insert-buffer-substring
+ nndoc-current-buffer (car entry) (nth 1 entry))
+ (insert "\n")
+ (setq beg (point))
+ (insert-buffer-substring
+ nndoc-current-buffer (nth 2 entry) (nth 3 entry))
+ (goto-char beg)
+ (when nndoc-prepare-body-function
+ (funcall nndoc-prepare-body-function))
+ (when nndoc-article-transform-function
+ (funcall nndoc-article-transform-function article))
+ t)))))
+
+(deffoo nndoc-request-group (group &optional server dont-check)
+ "Select news GROUP."
+ (let (number)
+ (cond
+ ((not (nndoc-possibly-change-buffer group server))
+ (nnheader-report 'nndoc "No such file or buffer: %s"
+ nndoc-address))
+ (dont-check
+ (nnheader-report 'nndoc "Selected group %s" group)
+ t)
+ ((zerop (setq number (length nndoc-dissection-alist)))
+ (nndoc-close-group group)
+ (nnheader-report 'nndoc "No articles in group %s" group))
+ (t
+ (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
+
+(deffoo nndoc-request-type (group &optional article)
+ (cond ((not article) 'unknown)
+ (nndoc-post-type nndoc-post-type)
+ (t 'unknown)))
+
+(deffoo nndoc-close-group (group &optional server)
+ (nndoc-possibly-change-buffer group server)
+ (and nndoc-current-buffer
+ (buffer-name nndoc-current-buffer)
+ (kill-buffer nndoc-current-buffer))
+ (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
+ nndoc-group-alist))
+ (setq nndoc-current-buffer nil)
+ (nnoo-close-server 'nndoc server)
+ (setq nndoc-dissection-alist nil)
+ t)
+
+(deffoo nndoc-request-list (&optional server)
+ nil)
+
+(deffoo nndoc-request-newgroups (date &optional server)
+ nil)
+
+(deffoo nndoc-request-list-newsgroups (&optional server)
+ nil)
+
+\f
+;;; Internal functions.
+
+(defun nndoc-possibly-change-buffer (group source)
+ (let (buf)
+ (cond
+ ;; The current buffer is this group's buffer.
+ ((and nndoc-current-buffer
+ (buffer-name nndoc-current-buffer)
+ (eq nndoc-current-buffer
+ (setq buf (cdr (assoc group nndoc-group-alist))))))
+ ;; We change buffers by taking an old from the group alist.
+ ;; `source' is either a string (a file name) or a buffer object.
+ (buf
+ (setq nndoc-current-buffer buf))
+ ;; It's a totally new group.
+ ((or (and (bufferp nndoc-address)
+ (buffer-name nndoc-address))
+ (and (stringp nndoc-address)
+ (file-exists-p nndoc-address)
+ (not (file-directory-p nndoc-address))))
+ (push (cons group (setq nndoc-current-buffer
+ (get-buffer-create
+ (concat " *nndoc " group "*"))))
+ nndoc-group-alist)
+ (setq nndoc-dissection-alist nil)
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (if (stringp nndoc-address)
+ (nnheader-insert-file-contents nndoc-address)
+ (insert-buffer-substring nndoc-address)))))
+ ;; Initialize the nndoc structures according to this new document.
+ (when (and nndoc-current-buffer
+ (not nndoc-dissection-alist))
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (nndoc-set-delims)
+ (nndoc-dissect-buffer)))
+ (unless nndoc-current-buffer
+ (nndoc-close-server))
+ ;; Return whether we managed to select a file.
+ nndoc-current-buffer))
+
+;;;
+;;; Deciding what document type we have
+;;;
+
+(defun nndoc-set-delims ()
+ "Set the nndoc delimiter variables according to the type of the document."
+ (let ((vars '(nndoc-file-begin
+ nndoc-first-article
+ nndoc-article-end nndoc-head-begin nndoc-head-end
+ nndoc-file-end nndoc-article-begin
+ nndoc-body-begin nndoc-body-end-function nndoc-body-end
+ nndoc-prepare-body-function nndoc-article-transform-function
+ nndoc-generate-head-function nndoc-body-begin-function
+ nndoc-head-begin-function)))
+ (while vars
+ (set (pop vars) nil)))
+ (let (defs)
+ ;; Guess away until we find the real file type.
+ (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
+ nndoc-type-alist))))
+ (setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
+ ;; Set the nndoc variables.
+ (while defs
+ (set (intern (format "nndoc-%s" (caar defs)))
+ (cdr (pop defs))))))
+
+(defun nndoc-guess-type (subtype)
+ (let ((alist nndoc-type-alist)
+ results result entry)
+ (while (and (not result)
+ (setq entry (pop alist)))
+ (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
+ (goto-char (point-min))
+ (when (numberp (setq result (funcall (intern
+ (format "nndoc-%s-type-p"
+ (car entry))))))
+ (push (cons result entry) results)
+ (setq result nil))))
+ (unless (or result results)
+ (error "Document is not of any recognized type"))
+ (if result
+ (car entry)
+ (cadar (sort results 'car-less-than-car)))))
+
+;;;
+;;; Built-in type predicates and functions
+;;;
+
+(defun nndoc-mbox-type-p ()
+ (when (looking-at message-unix-mail-delimiter)
+ t))
+
+(defun nndoc-mbox-article-begin ()
+ (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
+ (goto-char (match-beginning 0))))
+
+(defun nndoc-mbox-body-end ()
+ (let ((beg (point))
+ len end)
+ (when
+ (save-excursion
+ (and (re-search-backward
+ (concat "^" message-unix-mail-delimiter) nil t)
+ (setq end (point))
+ (search-forward "\n\n" beg t)
+ (re-search-backward
+ "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
+ (setq len (string-to-int (match-string 1)))
+ (search-forward "\n\n" beg t)
+ (unless (= (setq len (+ (point) len)) (point-max))
+ (and (< len (point-max))
+ (goto-char len)
+ (looking-at message-unix-mail-delimiter)))))
+ (goto-char len))))
+
+(defun nndoc-mmdf-type-p ()
+ (when (looking-at "\^A\^A\^A\^A$")
+ t))
+
+(defun nndoc-news-type-p ()
+ (when (looking-at "^Path:.*\n")
+ t))
+
+(defun nndoc-rnews-type-p ()
+ (when (looking-at "#! *rnews")
+ t))
+
+(defun nndoc-rnews-body-end ()
+ (and (re-search-backward nndoc-article-begin nil t)
+ (forward-line 1)
+ (goto-char (+ (point) (string-to-int (match-string 1))))))
+
+(defun nndoc-babyl-type-p ()
+ (when (re-search-forward "\^_\^L *\n" nil t)
+ t))
+
+(defun nndoc-babyl-body-begin ()
+ (re-search-forward "^\n" nil t)
+ (when (looking-at "\*\*\* EOOH \*\*\*")
+ (let ((next (or (save-excursion
+ (re-search-forward nndoc-article-begin nil t))
+ (point-max))))
+ (unless (re-search-forward "^\n" next t)
+ (goto-char next)
+ (forward-line -1)
+ (insert "\n")
+ (forward-line -1)))))
+
+(defun nndoc-babyl-head-begin ()
+ (when (re-search-forward "^[0-9].*\n" nil t)
+ (when (looking-at "\*\*\* EOOH \*\*\*")
+ (forward-line 1))
+ t))
+
+(defun nndoc-forward-type-p ()
+ (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
+ (not (re-search-forward "^Subject:.*digest" nil t))
+ (not (re-search-backward "^From:" nil t 2))
+ (not (re-search-forward "^From:" nil t 2)))
+ t))
+
+(defun nndoc-rfc934-type-p ()
+ (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t)
+ (not (re-search-forward "^Subject:.*digest" nil t))
+ (not (re-search-backward "^From:" nil t 2))
+ (not (re-search-forward "^From:" nil t 2)))
+ t))
+
+(defun nndoc-rfc822-forward-type-p ()
+ (save-restriction
+ (message-narrow-to-head)
+ (when (re-search-forward "^Content-Type: *message/rfc822" nil t)
+ t)))
+
+(defun nndoc-rfc822-forward-body-end-function ()
+ (goto-char (point-max)))
+
+(defun nndoc-clari-briefs-type-p ()
+ (when (let ((case-fold-search nil))
+ (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
+ t))
+
+(defun nndoc-transform-clari-briefs (article)
+ (goto-char (point-min))
+ (when (looking-at " *\\*\\(.*\\)\n")
+ (replace-match "" t t))
+ (nndoc-generate-clari-briefs-head article))
+
+(defun nndoc-generate-clari-briefs-head (article)
+ (let ((entry (cdr (assq article nndoc-dissection-alist)))
+ subject from)
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (save-restriction
+ (narrow-to-region (car entry) (nth 3 entry))
+ (goto-char (point-min))
+ (when (looking-at " *\\*\\(.*\\)$")
+ (setq subject (match-string 1))
+ (when (string-match "[ \t]+$" subject)
+ (setq subject (substring subject 0 (match-beginning 0)))))
+ (when
+ (let ((case-fold-search nil))
+ (re-search-forward
+ "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t))
+ (setq from (match-string 1)))))
+ (insert "From: " "clari@clari.net (" (or from "unknown") ")"
+ "\nSubject: " (or subject "(no subject)") "\n")))
+
+(defun nndoc-mime-digest-type-p ()
+ (let ((case-fold-search t)
+ boundary-id b-delimiter entry)
+ (when (and
+ (re-search-forward
+ (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
+ "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
+ nil t)
+ (match-beginning 1))
+ (setq boundary-id (match-string 1)
+ b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
+ (setq entry (assq 'mime-digest nndoc-type-alist))
+ (setcdr entry
+ (list
+ (cons 'head-end "^ ?$")
+ (cons 'body-begin "^ ?\n")
+ (cons 'article-begin b-delimiter)
+ (cons 'body-end-function 'nndoc-digest-body-end)
+ (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
+ t)))
+
+(defun nndoc-standard-digest-type-p ()
+ (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
+ (re-search-forward
+ (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
+ t))
+
+(defun nndoc-digest-body-end ()
+ (and (re-search-forward nndoc-article-begin nil t)
+ (goto-char (match-beginning 0))))
+
+(defun nndoc-slack-digest-type-p ()
+ 0)
+
+(defun nndoc-lanl-gov-announce-type-p ()
+ (when (let ((case-fold-search nil))
+ (re-search-forward "^\\\\\\\\\nPaper: [a-z-]+/[0-9]+" nil t))
+ t))
+
+(defun nndoc-transform-lanl-gov-announce (article)
+ (goto-char (point-max))
+ (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
+ (replace-match "\n\nGet it at \\1 (\\2)" t nil))
+ ;; (when (re-search-backward "^\\\\\\\\$" nil t)
+ ;; (replace-match "" t t))
+ )
+
+(defun nndoc-generate-lanl-gov-head (article)
+ (let ((entry (cdr (assq article nndoc-dissection-alist)))
+ (e-mail "no address given")
+ subject from)
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (save-restriction
+ (narrow-to-region (car entry) (nth 1 entry))
+ (goto-char (point-min))
+ (when (looking-at "^Paper.*: \\([a-z-]+/[0-9]+\\)")
+ (setq subject (concat " (" (match-string 1) ")"))
+ (when (re-search-forward "^From: \\([^ ]+\\)" nil t)
+ (setq e-mail (match-string 1)))
+ (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)"
+ nil t)
+ (setq subject (concat (match-string 1) subject))
+ (setq from (concat (match-string 2) " <" e-mail ">"))))
+ ))
+ (while (and from (string-match "(\[^)\]*)" from))
+ (setq from (replace-match "" t t from)))
+ (insert "From: " (or from "unknown")
+ "\nSubject: " (or subject "(no subject)") "\n")))
+
+
+
+;;;
+;;; Functions for dissecting the documents
+;;;
+
+(defun nndoc-search (regexp)
+ (prog1
+ (re-search-forward regexp nil t)
+ (beginning-of-line)))
+
+(defun nndoc-dissect-buffer ()
+ "Go through the document and partition it into heads/bodies/articles."
+ (let ((i 0)
+ (first t)
+ head-begin head-end body-begin body-end)
+ (setq nndoc-dissection-alist nil)
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (goto-char (point-min))
+ ;; Find the beginning of the file.
+ (when nndoc-file-begin
+ (nndoc-search nndoc-file-begin))
+ ;; Go through the file.
+ (while (if (and first nndoc-first-article)
+ (nndoc-search nndoc-first-article)
+ (nndoc-article-begin))
+ (setq first nil)
+ (cond (nndoc-head-begin-function
+ (funcall nndoc-head-begin-function))
+ (nndoc-head-begin
+ (nndoc-search nndoc-head-begin)))
+ (if (or (>= (point) (point-max))
+ (and nndoc-file-end
+ (looking-at nndoc-file-end)))
+ (goto-char (point-max))
+ (setq head-begin (point))
+ (nndoc-search (or nndoc-head-end "^$"))
+ (setq head-end (point))
+ (if nndoc-body-begin-function
+ (funcall nndoc-body-begin-function)
+ (nndoc-search (or nndoc-body-begin "^\n")))
+ (setq body-begin (point))
+ (or (and nndoc-body-end-function
+ (funcall nndoc-body-end-function))
+ (and nndoc-body-end
+ (nndoc-search nndoc-body-end))
+ (nndoc-article-begin)
+ (progn
+ (goto-char (point-max))
+ (when nndoc-file-end
+ (and (re-search-backward nndoc-file-end nil t)
+ (beginning-of-line)))))
+ (setq body-end (point))
+ (push (list (incf i) head-begin head-end body-begin body-end
+ (count-lines body-begin body-end))
+ nndoc-dissection-alist))))))
+
+(defun nndoc-article-begin ()
+ (if nndoc-article-begin-function
+ (funcall nndoc-article-begin-function)
+ (ignore-errors
+ (nndoc-search nndoc-article-begin))))
+
+(defun nndoc-unquote-dashes ()
+ "Unquote quoted non-separators in digests."
+ (while (re-search-forward "^- -"nil t)
+ (replace-match "-" t t)))
+
+;;;###autoload
+(defun nndoc-add-type (definition &optional position)
+ "Add document DEFINITION to the list of nndoc document definitions.
+If POSITION is nil or `last', the definition will be added
+as the last checked definition, if t or `first', add as the
+first definition, and if any other symbol, add after that
+symbol in the alist."
+ ;; First remove any old instances.
+ (setq nndoc-type-alist
+ (delq (assq (car definition) nndoc-type-alist)
+ nndoc-type-alist))
+ ;; Then enter the new definition in the proper place.
+ (cond
+ ((or (null position) (eq position 'last))
+ (setq nndoc-type-alist (nconc nndoc-type-alist (list definition))))
+ ((or (eq position t) (eq position 'first))
+ (push definition nndoc-type-alist))
+ (t
+ (let ((list (memq (assq position nndoc-type-alist)
+ nndoc-type-alist)))
+ (unless list
+ (error "No such position: %s" position))
+ (setcdr list (cons definition (cdr list)))))))
+
+(provide 'nndoc)
+
+;;; nndoc.el ends here
--- /dev/null
+;;; nndraft.el --- draft article access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmail)
+(require 'gnus-start)
+(require 'nnmh)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nndraft
+ nnmh)
+
+(defvoo nndraft-directory (nnheader-concat gnus-directory "drafts/")
+ "Where nndraft will store its files."
+ nnmh-directory)
+
+\f
+
+(defvoo nndraft-current-group "" nil nnmh-current-group)
+(defvoo nndraft-get-new-mail nil nil nnmh-get-new-mail)
+(defvoo nndraft-current-directory nil nil nnmh-current-directory)
+
+(defconst nndraft-version "nndraft 1.0")
+(defvoo nndraft-status-string "" nil nnmh-status-string)
+
+\f
+
+;;; Interface functions.
+
+(nnoo-define-basics nndraft)
+
+(deffoo nndraft-open-server (server &optional defs)
+ (nnoo-change-server 'nndraft server defs)
+ (cond
+ ((not (file-exists-p nndraft-directory))
+ (nndraft-close-server)
+ (nnheader-report 'nndraft "No such file or directory: %s"
+ nndraft-directory))
+ ((not (file-directory-p (file-truename nndraft-directory)))
+ (nndraft-close-server)
+ (nnheader-report 'nndraft "Not a directory: %s" nndraft-directory))
+ (t
+ (nnheader-report 'nndraft "Opened server %s using directory %s"
+ server nndraft-directory)
+ t)))
+
+(deffoo nndraft-retrieve-headers (articles &optional group server fetch-old)
+ (nndraft-possibly-change-group group)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let* ((buf (get-buffer-create " *draft headers*"))
+ article)
+ (set-buffer buf)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ ;; We don't support fetching by Message-ID.
+ (if (stringp (car articles))
+ 'headers
+ (while articles
+ (set-buffer buf)
+ (when (nndraft-request-article
+ (setq article (pop articles)) group server (current-buffer))
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (forward-line -1)
+ (goto-char (point-max)))
+ (delete-region (point) (point-max))
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-max))
+ (insert (format "221 %d Article retrieved.\n" article))
+ (insert-buffer-substring buf)
+ (insert ".\n")))
+
+ (nnheader-fold-continuation-lines)
+ 'headers))))
+
+(deffoo nndraft-request-article (id &optional group server buffer)
+ (nndraft-possibly-change-group group)
+ (when (numberp id)
+ ;; We get the newest file of the auto-saved file and the
+ ;; "real" file.
+ (let* ((file (nndraft-article-filename id))
+ (auto (nndraft-auto-save-file-name file))
+ (newest (if (file-newer-than-file-p file auto) file auto))
+ (nntp-server-buffer (or buffer nntp-server-buffer)))
+ (when (and (file-exists-p newest)
+ (nnmail-find-file newest))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ ;; If there's a mail header separator in this file,
+ ;; we remove it.
+ (when (re-search-forward
+ (concat "^" mail-header-separator "$") nil t)
+ (replace-match "" t t)))
+ t))))
+
+(deffoo nndraft-request-restore-buffer (article &optional group server)
+ "Request a new buffer that is restored to the state of ARTICLE."
+ (nndraft-possibly-change-group group)
+ (when (nndraft-request-article article group server (current-buffer))
+ (let ((gnus-verbose-backends nil))
+ (nndraft-request-expire-articles (list article) group server t))
+ t))
+
+(deffoo nndraft-request-update-info (group info &optional server)
+ (nndraft-possibly-change-group group)
+ (gnus-info-set-read
+ info
+ (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft ""))
+ (nndraft-articles) t))
+ (let (marks)
+ (when (setq marks (nth 3 info))
+ (setcar (nthcdr 3 info)
+ (if (assq 'unsend marks)
+ (list (assq 'unsend marks))
+ nil))))
+ t)
+
+(deffoo nndraft-request-associate-buffer (group)
+ "Associate the current buffer with some article in the draft group."
+ (nndraft-possibly-change-group group)
+ (let ((gnus-verbose-backends nil)
+ (buf (current-buffer))
+ article file)
+ (nnheader-temp-write nil
+ (insert-buffer buf)
+ (setq article (nndraft-request-accept-article
+ group (nnoo-current-server 'nndraft) t 'noinsert))
+ (setq file (nndraft-article-filename article)))
+ (setq buffer-file-name file)
+ (setq buffer-auto-save-file-name (make-auto-save-file-name))
+ (clear-visited-file-modtime)
+ article))
+
+(deffoo nndraft-request-expire-articles (articles group &optional server force)
+ (nndraft-possibly-change-group group)
+ (let* ((nnmh-allow-delete-final t)
+ (res (nndraft-execute-nnmh-command
+ `(nnmh-request-expire-articles
+ ',articles group ,server ,force)))
+ article)
+ ;; Delete all the "state" files of articles that have been expired.
+ (while articles
+ (unless (memq (setq article (pop articles)) res)
+ (let ((auto (nndraft-auto-save-file-name
+ (nndraft-article-filename article))))
+ (when (file-exists-p auto)
+ (funcall nnmail-delete-file-function auto)))))
+ res))
+
+(deffoo nndraft-request-accept-article (group &optional server last noinsert)
+ (nndraft-possibly-change-group group)
+ (let ((gnus-verbose-backends nil))
+ (nndraft-execute-nnmh-command
+ `(nnmh-request-accept-article group ,server ,last noinsert))))
+
+(deffoo nndraft-request-create-group (group &optional server args)
+ (nndraft-possibly-change-group group)
+ (if (file-exists-p nndraft-current-directory)
+ (if (file-directory-p nndraft-current-directory)
+ t
+ nil)
+ (condition-case ()
+ (progn
+ (gnus-make-directory nndraft-current-directory)
+ t)
+ (file-error nil))))
+
+\f
+;;; Low-Level Interface
+
+(defun nndraft-possibly-change-group (group)
+ (when (and group
+ (not (equal group nndraft-current-group)))
+ (setq nndraft-current-group group)
+ (setq nndraft-current-directory
+ (nnheader-concat nndraft-directory group))))
+
+(defun nndraft-execute-nnmh-command (command)
+ (let* ((dir (directory-file-name
+ (expand-file-name nndraft-current-directory)))
+ (group (file-name-nondirectory dir))
+ (nnmh-directory (file-name-directory dir))
+ (nnmail-keep-last-article nil)
+ (nnmh-get-new-mail nil))
+ (eval command)))
+
+(defun nndraft-article-filename (article &rest args)
+ (apply 'concat
+ (file-name-as-directory nndraft-current-directory)
+ (int-to-string article)
+ args))
+
+(defun nndraft-auto-save-file-name (file)
+ (save-excursion
+ (prog1
+ (progn
+ (set-buffer (get-buffer-create " *draft tmp*"))
+ (setq buffer-file-name file)
+ (make-auto-save-file-name))
+ (kill-buffer (current-buffer)))))
+
+(defun nndraft-articles ()
+ "Return the list of messages in the group."
+ (gnus-make-directory nndraft-current-directory)
+ (sort
+ (mapcar 'string-to-int
+ (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t))
+ '<))
+
+(nnoo-import nndraft
+ (nnmh
+ nnmh-retrieve-headers
+ nnmh-request-group
+ nnmh-close-group
+ nnmh-request-list
+ nnmh-request-newsgroups
+ nnmh-request-move-article
+ nnmh-request-replace-article))
+
+(provide 'nndraft)
+
+;;; nndraft.el ends here
--- /dev/null
+;;; nneething.el --- random file access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'nnheader)
+(require 'nnmail)
+(require 'nnoo)
+(require 'gnus-util)
+
+(nnoo-declare nneething)
+
+(defvoo nneething-map-file-directory "~/.nneething/"
+ "Where nneething stores the map files.")
+
+(defvoo nneething-map-file ".nneething"
+ "Name of the map files.")
+
+(defvoo nneething-exclude-files nil
+ "Regexp saying what files to exclude from the group.
+If this variable is nil, no files will be excluded.")
+
+\f
+
+;;; Internal variables.
+
+(defconst nneething-version "nneething 1.0"
+ "nneething version.")
+
+(defvoo nneething-current-directory nil
+ "Current news group directory.")
+
+(defvoo nneething-status-string "")
+
+(defvoo nneething-message-id-number 0)
+(defvoo nneething-work-buffer " *nneething work*")
+
+(defvoo nneething-group nil)
+(defvoo nneething-map nil)
+(defvoo nneething-read-only nil)
+(defvoo nneething-active nil)
+(defvoo nneething-directory nil)
+
+\f
+
+;;; Interface functions.
+
+(nnoo-define-basics nneething)
+
+(deffoo nneething-retrieve-headers (articles &optional group server fetch-old)
+ (nneething-possibly-change-directory group)
+
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let* ((number (length articles))
+ (count 0)
+ (large (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)))
+ article file)
+
+ (if (stringp (car articles))
+ 'headers
+
+ (while (setq article (pop articles))
+ (setq file (nneething-file-name article))
+
+ (when (and (file-exists-p file)
+ (or (file-directory-p file)
+ (not (zerop (nnheader-file-size file)))))
+ (insert (format "221 %d Article retrieved.\n" article))
+ (nneething-insert-head file)
+ (insert ".\n"))
+
+ (incf count)
+
+ (and large
+ (zerop (% count 20))
+ (message "nneething: Receiving headers... %d%%"
+ (/ (* count 100) number))))
+
+ (when large
+ (message "nneething: Receiving headers...done"))
+
+ (nnheader-fold-continuation-lines)
+ 'headers))))
+
+(deffoo nneething-request-article (id &optional group server buffer)
+ (nneething-possibly-change-directory group)
+ (let ((file (unless (stringp id)
+ (nneething-file-name id)))
+ (nntp-server-buffer (or buffer nntp-server-buffer)))
+ (and (stringp file) ; We did not request by Message-ID.
+ (file-exists-p file) ; The file exists.
+ (not (file-directory-p file)) ; It's not a dir.
+ (save-excursion
+ (nnmail-find-file file) ; Insert the file in the nntp buf.
+ (unless (nnheader-article-p) ; Either it's a real article...
+ (goto-char (point-min))
+ (nneething-make-head file (current-buffer)) ; ... or we fake some headers.
+ (insert "\n"))
+ t))))
+
+(deffoo nneething-request-group (group &optional server dont-check)
+ (nneething-possibly-change-directory group server)
+ (unless dont-check
+ (nneething-create-mapping)
+ (if (> (car nneething-active) (cdr nneething-active))
+ (nnheader-insert "211 0 1 0 %s\n" group)
+ (nnheader-insert
+ "211 %d %d %d %s\n"
+ (- (1+ (cdr nneething-active)) (car nneething-active))
+ (car nneething-active) (cdr nneething-active)
+ group)))
+ t)
+
+(deffoo nneething-request-list (&optional server dir)
+ (nnheader-report 'nneething "LIST is not implemented."))
+
+(deffoo nneething-request-newgroups (date &optional server)
+ (nnheader-report 'nneething "NEWSGROUPS is not implemented."))
+
+(deffoo nneething-request-type (group &optional article)
+ 'unknown)
+
+(deffoo nneething-close-group (group &optional server)
+ (setq nneething-current-directory nil)
+ t)
+
+(deffoo nneething-open-server (server &optional defs)
+ (nnheader-init-server-buffer)
+ (if (nneething-server-opened server)
+ t
+ (unless (assq 'nneething-directory defs)
+ (setq defs (append defs (list (list 'nneething-directory server)))))
+ (nnoo-change-server 'nneething server defs)))
+
+\f
+;;; Internal functions.
+
+(defun nneething-possibly-change-directory (group &optional server)
+ (when (and server
+ (not (nneething-server-opened server)))
+ (nneething-open-server server))
+ (when (and group
+ (not (equal nneething-group group)))
+ (setq nneething-group group)
+ (setq nneething-map nil)
+ (setq nneething-active (cons 1 0))
+ (nneething-create-mapping)))
+
+(defun nneething-map-file ()
+ ;; We make sure that the .nneething directory exists.
+ (gnus-make-directory nneething-map-file-directory)
+ ;; We store it in a special directory under the user's home dir.
+ (concat (file-name-as-directory nneething-map-file-directory)
+ nneething-group nneething-map-file))
+
+(defun nneething-create-mapping ()
+ ;; Read nneething-active and nneething-map.
+ (when (file-exists-p nneething-directory)
+ (let ((map-file (nneething-map-file))
+ (files (directory-files nneething-directory))
+ touched map-files)
+ (when (file-exists-p map-file)
+ (ignore-errors
+ (load map-file nil t t)))
+ (unless nneething-active
+ (setq nneething-active (cons 1 0)))
+ ;; Old nneething had a different map format.
+ (when (and (cdar nneething-map)
+ (atom (cdar nneething-map)))
+ (setq nneething-map
+ (mapcar (lambda (n)
+ (list (cdr n) (car n)
+ (nth 5 (file-attributes
+ (nneething-file-name (car n))))))
+ nneething-map)))
+ ;; Remove files matching the exclusion regexp.
+ (when nneething-exclude-files
+ (let ((f files)
+ prev)
+ (while f
+ (if (string-match nneething-exclude-files (car f))
+ (if prev (setcdr prev (cdr f))
+ (setq files (cdr files)))
+ (setq prev f))
+ (setq f (cdr f)))))
+ ;; Remove deleted files from the map.
+ (let ((map nneething-map)
+ prev)
+ (while map
+ (if (and (member (cadar map) files)
+ ;; We also remove files that have changed mod times.
+ (equal (nth 5 (file-attributes
+ (nneething-file-name (cadar map))))
+ (caddar map)))
+ (progn
+ (push (cadar map) map-files)
+ (setq prev map))
+ (setq touched t)
+ (if prev
+ (setcdr prev (cdr map))
+ (setq nneething-map (cdr nneething-map))))
+ (setq map (cdr map))))
+ ;; Find all new files and enter them into the map.
+ (while files
+ (unless (member (car files) map-files)
+ ;; This file is not in the map, so we enter it.
+ (setq touched t)
+ (setcdr nneething-active (1+ (cdr nneething-active)))
+ (push (list (cdr nneething-active) (car files)
+ (nth 5 (file-attributes
+ (nneething-file-name (car files)))))
+ nneething-map))
+ (setq files (cdr files)))
+ (when (and touched
+ (not nneething-read-only))
+ (nnheader-temp-write map-file
+ (insert "(setq nneething-map '")
+ (gnus-prin1 nneething-map)
+ (insert ")\n(setq nneething-active '")
+ (gnus-prin1 nneething-active)
+ (insert ")\n"))))))
+
+(defun nneething-insert-head (file)
+ "Insert the head of FILE."
+ (when (nneething-get-head file)
+ (insert-buffer-substring nneething-work-buffer)
+ (goto-char (point-max))))
+
+(defun nneething-make-head (file &optional buffer)
+ "Create a head by looking at the file attributes of FILE."
+ (let ((atts (file-attributes file)))
+ (insert
+ "Subject: " (file-name-nondirectory file) "\n"
+ "Message-ID: <nneething-"
+ (int-to-string (incf nneething-message-id-number))
+ "@" (system-name) ">\n"
+ (if (equal '(0 0) (nth 5 atts)) ""
+ (concat "Date: " (current-time-string (nth 5 atts)) "\n"))
+ (or (when buffer
+ (save-excursion
+ (set-buffer buffer)
+ (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t)
+ (concat "From: " (match-string 0) "\n"))))
+ (nneething-from-line (nth 2 atts) file))
+ (if (> (string-to-int (int-to-string (nth 7 atts))) 0)
+ (concat "Chars: " (int-to-string (nth 7 atts)) "\n")
+ "")
+ (if buffer
+ (save-excursion
+ (set-buffer buffer)
+ (concat "Lines: " (int-to-string
+ (count-lines (point-min) (point-max)))
+ "\n"))
+ "")
+ )))
+
+(defun nneething-from-line (uid &optional file)
+ "Return a From header based of UID."
+ (let* ((login (condition-case nil
+ (user-login-name uid)
+ (error
+ (cond ((= uid (user-uid)) (user-login-name))
+ ((zerop uid) "root")
+ (t (int-to-string uid))))))
+ (name (condition-case nil
+ (user-full-name uid)
+ (error
+ (cond ((= uid (user-uid)) (user-full-name))
+ ((zerop uid) "Ms. Root")))))
+ (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file)
+ (prog1
+ (substring file
+ (match-beginning 1)
+ (match-end 1))
+ (when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file)
+ (setq login (substring file
+ (match-beginning 2)
+ (match-end 2))
+ name nil)))
+ (system-name))))
+ (concat "From: " login "@" host
+ (if name (concat " (" name ")") "") "\n")))
+
+(defun nneething-get-head (file)
+ "Either find the head in FILE or make a head for FILE."
+ (save-excursion
+ (set-buffer (get-buffer-create nneething-work-buffer))
+ (setq case-fold-search nil)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (cond
+ ((not (file-exists-p file))
+ ;; The file do not exist.
+ nil)
+ ((or (file-directory-p file)
+ (file-symlink-p file))
+ ;; It's a dir, so we fudge a head.
+ (nneething-make-head file) t)
+ (t
+ ;; We examine the file.
+ (nnheader-insert-head file)
+ (if (nnheader-article-p)
+ (delete-region
+ (progn
+ (goto-char (point-min))
+ (or (and (search-forward "\n\n" nil t)
+ (1- (point)))
+ (point-max)))
+ (point-max))
+ (goto-char (point-min))
+ (nneething-make-head file (current-buffer))
+ (delete-region (point) (point-max)))
+ t))))
+
+(defun nneething-file-name (article)
+ "Return the file name of ARTICLE."
+ (concat (file-name-as-directory nneething-directory)
+ (if (numberp article)
+ (cadr (assq article nneething-map))
+ article)))
+
+(provide 'nneething)
+
+;;; nneething.el ends here
--- /dev/null
+;;; nnfolder.el --- mail folder access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Scott Byer <byer@mv.us.adobe.com>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'message)
+(require 'nnmail)
+(require 'nnoo)
+(require 'cl)
+(require 'gnus-util)
+
+(nnoo-declare nnfolder)
+
+(defvoo nnfolder-directory (expand-file-name message-directory)
+ "The name of the nnfolder directory.")
+
+(defvoo nnfolder-active-file
+ (nnheader-concat nnfolder-directory "active")
+ "The name of the active file.")
+
+;; I renamed this variable to something more in keeping with the general GNU
+;; style. -SLB
+
+(defvoo nnfolder-ignore-active-file nil
+ "If non-nil, causes nnfolder to do some extra work in order to determine
+the true active ranges of an mbox file. Note that the active file is still
+saved, but it's values are not used. This costs some extra time when
+scanning an mbox when opening it.")
+
+(defvoo nnfolder-distrust-mbox nil
+ "If non-nil, causes nnfolder to not trust the user with respect to
+inserting unaccounted for mail in the middle of an mbox file. This can greatly
+slow down scans, which now must scan the entire file for unmarked messages.
+When nil, scans occur forward from the last marked message, a huge
+time saver for large mailboxes.")
+
+(defvoo nnfolder-newsgroups-file
+ (concat (file-name-as-directory nnfolder-directory) "newsgroups")
+ "Mail newsgroups description file.")
+
+(defvoo nnfolder-get-new-mail t
+ "If non-nil, nnfolder will check the incoming mail file and split the mail.")
+
+(defvoo nnfolder-prepare-save-mail-hook nil
+ "Hook run narrowed to an article before saving.")
+
+(defvoo nnfolder-save-buffer-hook nil
+ "Hook run before saving the nnfolder mbox buffer.")
+
+(defvoo nnfolder-inhibit-expiry nil
+ "If non-nil, inhibit expiry.")
+
+\f
+
+(defconst nnfolder-version "nnfolder 1.0"
+ "nnfolder version.")
+
+(defconst nnfolder-article-marker "X-Gnus-Article-Number: "
+ "String used to demarcate what the article number for a message is.")
+
+(defvoo nnfolder-current-group nil)
+(defvoo nnfolder-current-buffer nil)
+(defvoo nnfolder-status-string "")
+(defvoo nnfolder-group-alist nil)
+(defvoo nnfolder-buffer-alist nil)
+(defvoo nnfolder-scantime-alist nil)
+(defvoo nnfolder-active-timestamp nil)
+
+\f
+
+;;; Interface functions
+
+(nnoo-define-basics nnfolder)
+
+(deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let (article art-string start stop)
+ (nnfolder-possibly-change-group group server)
+ (when nnfolder-current-buffer
+ (set-buffer nnfolder-current-buffer)
+ (goto-char (point-min))
+ (if (stringp (car articles))
+ 'headers
+ (while articles
+ (setq article (car articles))
+ (setq art-string (nnfolder-article-string article))
+ (set-buffer nnfolder-current-buffer)
+ (when (or (search-forward art-string nil t)
+ ;; Don't search the whole file twice! Also, articles
+ ;; probably have some locality by number, so searching
+ ;; backwards will be faster. Especially if we're at the
+ ;; beginning of the buffer :-). -SLB
+ (search-backward art-string nil t))
+ (nnmail-search-unix-mail-delim-backward)
+ (setq start (point))
+ (search-forward "\n\n" nil t)
+ (setq stop (1- (point)))
+ (set-buffer nntp-server-buffer)
+ (insert (format "221 %d Article retrieved.\n" article))
+ (insert-buffer-substring nnfolder-current-buffer start stop)
+ (goto-char (point-max))
+ (insert ".\n"))
+ (setq articles (cdr articles)))
+
+ (set-buffer nntp-server-buffer)
+ (nnheader-fold-continuation-lines)
+ 'headers)))))
+
+(deffoo nnfolder-open-server (server &optional defs)
+ (nnoo-change-server 'nnfolder server defs)
+ (nnmail-activate 'nnfolder t)
+ (gnus-make-directory nnfolder-directory)
+ (cond
+ ((not (file-exists-p nnfolder-directory))
+ (nnfolder-close-server)
+ (nnheader-report 'nnfolder "Couldn't create directory: %s"
+ nnfolder-directory))
+ ((not (file-directory-p (file-truename nnfolder-directory)))
+ (nnfolder-close-server)
+ (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory))
+ (t
+ (nnmail-activate 'nnfolder)
+ (nnheader-report 'nnfolder "Opened server %s using directory %s"
+ server nnfolder-directory)
+ t)))
+
+(deffoo nnfolder-request-close ()
+ (let ((alist nnfolder-buffer-alist))
+ (while alist
+ (nnfolder-close-group (caar alist) nil t)
+ (setq alist (cdr alist))))
+ (nnoo-close-server 'nnfolder)
+ (setq nnfolder-buffer-alist nil
+ nnfolder-group-alist nil))
+
+(deffoo nnfolder-request-article (article &optional group server buffer)
+ (nnfolder-possibly-change-group group server)
+ (save-excursion
+ (set-buffer nnfolder-current-buffer)
+ (goto-char (point-min))
+ (when (search-forward (nnfolder-article-string article) nil t)
+ (let (start stop)
+ (nnmail-search-unix-mail-delim-backward)
+ (setq start (point))
+ (forward-line 1)
+ (unless (and (nnmail-search-unix-mail-delim)
+ (forward-line -1))
+ (goto-char (point-max)))
+ (setq stop (point))
+ (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring nnfolder-current-buffer start stop)
+ (goto-char (point-min))
+ (while (looking-at "From ")
+ (delete-char 5)
+ (insert "X-From-Line: ")
+ (forward-line 1))
+ (if (numberp article)
+ (cons nnfolder-current-group article)
+ (goto-char (point-min))
+ (search-forward (concat "\n" nnfolder-article-marker))
+ (cons nnfolder-current-group
+ (string-to-int
+ (buffer-substring
+ (point) (progn (end-of-line) (point)))))))))))
+
+(deffoo nnfolder-request-group (group &optional server dont-check)
+ (nnfolder-possibly-change-group group server t)
+ (save-excursion
+ (if (not (assoc group nnfolder-group-alist))
+ (nnheader-report 'nnfolder "No such group: %s" group)
+ (if dont-check
+ (progn
+ (nnheader-report 'nnfolder "Selected group %s" group)
+ t)
+ (let* ((active (assoc group nnfolder-group-alist))
+ (group (car active))
+ (range (cadr active)))
+ (cond
+ ((null active)
+ (nnheader-report 'nnfolder "No such group: %s" group))
+ ((null nnfolder-current-group)
+ (nnheader-report 'nnfolder "Empty group: %s" group))
+ (t
+ (nnheader-report 'nnfolder "Selected group %s" group)
+ (nnheader-insert "211 %d %d %d %s\n"
+ (1+ (- (cdr range) (car range)))
+ (car range) (cdr range) group))))))))
+
+(deffoo nnfolder-request-scan (&optional group server)
+ (nnfolder-possibly-change-group nil server)
+ (when nnfolder-get-new-mail
+ (nnfolder-possibly-change-group group server)
+ (nnmail-get-new-mail
+ 'nnfolder
+ (lambda ()
+ (let ((bufs nnfolder-buffer-alist))
+ (save-excursion
+ (while bufs
+ (if (not (gnus-buffer-live-p (nth 1 (car bufs))))
+ (setq nnfolder-buffer-alist
+ (delq (car bufs) nnfolder-buffer-alist))
+ (set-buffer (nth 1 (car bufs)))
+ (nnfolder-save-buffer)
+ (kill-buffer (current-buffer)))
+ (setq bufs (cdr bufs))))))
+ nnfolder-directory
+ group)))
+
+;; Don't close the buffer if we're not shutting down the server. This way,
+;; we can keep the buffer in the group buffer cache, and not have to grovel
+;; over the buffer again unless we add new mail to it or modify it in some
+;; way.
+
+(deffoo nnfolder-close-group (group &optional server force)
+ ;; Make sure we _had_ the group open.
+ (when (or (assoc group nnfolder-buffer-alist)
+ (equal group nnfolder-current-group))
+ (let ((inf (assoc group nnfolder-buffer-alist)))
+ (when inf
+ (when (and nnfolder-current-group
+ nnfolder-current-buffer)
+ (push (list nnfolder-current-group nnfolder-current-buffer)
+ nnfolder-buffer-alist))
+ (setq nnfolder-buffer-alist
+ (delq inf nnfolder-buffer-alist))
+ (setq nnfolder-current-buffer (cadr inf)
+ nnfolder-current-group (car inf))))
+ (when (and nnfolder-current-buffer
+ (buffer-name nnfolder-current-buffer))
+ (save-excursion
+ (set-buffer nnfolder-current-buffer)
+ ;; If the buffer was modified, write the file out now.
+ (nnfolder-save-buffer)
+ ;; If we're shutting the server down, we need to kill the
+ ;; buffer and remove it from the open buffer list. Or, of
+ ;; course, if we're trying to minimize our space impact.
+ (kill-buffer (current-buffer))
+ (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist)
+ nnfolder-buffer-alist)))))
+ (setq nnfolder-current-group nil
+ nnfolder-current-buffer nil)
+ t)
+
+(deffoo nnfolder-request-create-group (group &optional server args)
+ (nnfolder-possibly-change-group nil server)
+ (nnmail-activate 'nnfolder)
+ (when group
+ (unless (assoc group nnfolder-group-alist)
+ (push (list group (cons 1 0)) nnfolder-group-alist)
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+ (nnfolder-read-folder group)))
+ t)
+
+(deffoo nnfolder-request-list (&optional server)
+ (nnfolder-possibly-change-group nil server)
+ (save-excursion
+ (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
+ (pathname-coding-system 'binary))
+ (nnmail-find-file nnfolder-active-file)
+ (setq nnfolder-group-alist (nnmail-get-active)))
+ t))
+
+(deffoo nnfolder-request-newgroups (date &optional server)
+ (nnfolder-possibly-change-group nil server)
+ (nnfolder-request-list server))
+
+(deffoo nnfolder-request-list-newsgroups (&optional server)
+ (nnfolder-possibly-change-group nil server)
+ (save-excursion
+ (nnmail-find-file nnfolder-newsgroups-file)))
+
+(deffoo nnfolder-request-expire-articles
+ (articles newsgroup &optional server force)
+ (nnfolder-possibly-change-group newsgroup server)
+ (let* ((is-old t)
+ rest)
+ (nnmail-activate 'nnfolder)
+
+ (save-excursion
+ (set-buffer nnfolder-current-buffer)
+ (while (and articles is-old)
+ (goto-char (point-min))
+ (when (search-forward (nnfolder-article-string (car articles)) nil t)
+ (if (setq is-old
+ (nnmail-expired-article-p
+ newsgroup
+ (buffer-substring
+ (point) (progn (end-of-line) (point)))
+ force nnfolder-inhibit-expiry))
+ (progn
+ (nnheader-message 5 "Deleting article %d..."
+ (car articles) newsgroup)
+ (nnfolder-delete-mail))
+ (push (car articles) rest)))
+ (setq articles (cdr articles)))
+ (unless nnfolder-inhibit-expiry
+ (nnheader-message 5 "Deleting articles...done"))
+ (nnfolder-save-buffer)
+ (nnfolder-adjust-min-active newsgroup)
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+ (nconc rest articles))))
+
+(deffoo nnfolder-request-move-article
+ (article group server accept-form &optional last)
+ (let ((buf (get-buffer-create " *nnfolder move*"))
+ result)
+ (and
+ (nnfolder-request-article article group server)
+ (save-excursion
+ (set-buffer buf)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-buffer-substring nntp-server-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat "^" nnfolder-article-marker)
+ (save-excursion (search-forward "\n\n" nil t) (point)) t)
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ (setq result (eval accept-form))
+ (kill-buffer buf)
+ result)
+ (save-excursion
+ (nnfolder-possibly-change-group group server)
+ (set-buffer nnfolder-current-buffer)
+ (goto-char (point-min))
+ (when (search-forward (nnfolder-article-string article) nil t)
+ (nnfolder-delete-mail))
+ (when last
+ (nnfolder-save-buffer)
+ (nnfolder-adjust-min-active group)
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file))))
+ result))
+
+(deffoo nnfolder-request-accept-article (group &optional server last)
+ (nnfolder-possibly-change-group group server)
+ (nnmail-check-syntax)
+ (let ((buf (current-buffer))
+ result art-group)
+ (goto-char (point-min))
+ (when (looking-at "X-From-Line: ")
+ (replace-match "From "))
+ (and
+ (nnfolder-request-list)
+ (save-excursion
+ (set-buffer buf)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (forward-line -1)
+ (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (setq result (if (stringp group)
+ (list (cons group (nnfolder-active-number group)))
+ (setq art-group
+ (nnmail-article-group 'nnfolder-active-number))))
+ (if (and (null result)
+ (yes-or-no-p "Moved to `junk' group; delete article? "))
+ (setq result 'junk)
+ (setq result
+ (car (nnfolder-save-mail result)))))
+ (when last
+ (save-excursion
+ (nnfolder-possibly-change-folder (or (caar art-group) group))
+ (nnfolder-save-buffer)
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-close)))))
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+ (unless result
+ (nnheader-report 'nnfolder "Couldn't store article"))
+ result))
+
+(deffoo nnfolder-request-replace-article (article group buffer)
+ (nnfolder-possibly-change-group group)
+ (save-excursion
+ (set-buffer nnfolder-current-buffer)
+ (goto-char (point-min))
+ (if (not (search-forward (nnfolder-article-string article) nil t))
+ nil
+ (nnfolder-delete-mail t t)
+ (insert-buffer-substring buffer)
+ (nnfolder-save-buffer)
+ t)))
+
+(deffoo nnfolder-request-delete-group (group &optional force server)
+ (nnfolder-close-group group server t)
+ ;; Delete all articles in GROUP.
+ (if (not force)
+ () ; Don't delete the articles.
+ ;; Delete the file that holds the group.
+ (ignore-errors
+ (delete-file (nnfolder-group-pathname group))))
+ ;; Remove the group from all structures.
+ (setq nnfolder-group-alist
+ (delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
+ nnfolder-current-group nil
+ nnfolder-current-buffer nil)
+ ;; Save the active file.
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+ t)
+
+(deffoo nnfolder-request-rename-group (group new-name &optional server)
+ (nnfolder-possibly-change-group group server)
+ (save-excursion
+ (set-buffer nnfolder-current-buffer)
+ (and (file-writable-p buffer-file-name)
+ (ignore-errors
+ (rename-file
+ buffer-file-name
+ (nnfolder-group-pathname new-name))
+ t)
+ ;; That went ok, so we change the internal structures.
+ (let ((entry (assoc group nnfolder-group-alist)))
+ (and entry (setcar entry new-name))
+ (setq nnfolder-current-buffer nil
+ nnfolder-current-group nil)
+ ;; Save the new group alist.
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+ ;; We kill the buffer instead of renaming it and stuff.
+ (kill-buffer (current-buffer))
+ t))))
+
+(defun nnfolder-request-regenerate (server)
+ (nnfolder-possibly-change-group nil server)
+ (nnfolder-generate-active-file)
+ t)
+
+\f
+;;; Internal functions.
+
+(defun nnfolder-adjust-min-active (group)
+ ;; Find the lowest active article in this group.
+ (let* ((active (cadr (assoc group nnfolder-group-alist)))
+ (marker (concat "\n" nnfolder-article-marker))
+ (number "[0-9]+")
+ (activemin (cdr active)))
+ (save-excursion
+ (set-buffer nnfolder-current-buffer)
+ (goto-char (point-min))
+ (while (and (search-forward marker nil t)
+ (re-search-forward number nil t))
+ (setq activemin (min activemin
+ (string-to-number (buffer-substring
+ (match-beginning 0)
+ (match-end 0))))))
+ (setcar active activemin))))
+
+(defun nnfolder-article-string (article)
+ (if (numberp article)
+ (concat "\n" nnfolder-article-marker (int-to-string article) " ")
+ (concat "\nMessage-ID: " article)))
+
+(defun nnfolder-delete-mail (&optional force leave-delim)
+ "Delete the message that point is in."
+ (save-excursion
+ (delete-region
+ (save-excursion
+ (nnmail-search-unix-mail-delim-backward)
+ (if leave-delim (progn (forward-line 1) (point))
+ (point)))
+ (progn
+ (forward-line 1)
+ (if (nnmail-search-unix-mail-delim)
+ (if (and (not (bobp)) leave-delim)
+ (progn (forward-line -2) (point))
+ (point))
+ (point-max))))))
+
+(defun nnfolder-possibly-change-group (group &optional server dont-check)
+ ;; Change servers.
+ (when (and server
+ (not (nnfolder-server-opened server)))
+ (nnfolder-open-server server))
+ (unless (gnus-buffer-live-p nnfolder-current-buffer)
+ (setq nnfolder-current-buffer nil
+ nnfolder-current-group nil))
+ ;; Change group.
+ (when (and group
+ (not (equal group nnfolder-current-group)))
+ (let ((pathname-coding-system 'binary))
+ (nnmail-activate 'nnfolder)
+ (when (and (not (assoc group nnfolder-group-alist))
+ (not (file-exists-p
+ (nnfolder-group-pathname group))))
+ ;; The group doesn't exist, so we create a new entry for it.
+ (push (list group (cons 1 0)) nnfolder-group-alist)
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
+
+ (if dont-check
+ (setq nnfolder-current-group group
+ nnfolder-current-buffer nil)
+ (let (inf file)
+ ;; If we have to change groups, see if we don't already have the
+ ;; folder in memory. If we do, verify the modtime and destroy
+ ;; the folder if needed so we can rescan it.
+ (setq nnfolder-current-buffer
+ (nth 1 (assoc group nnfolder-buffer-alist)))
+
+ ;; If the buffer is not live, make sure it isn't in the alist. If it
+ ;; is live, verify that nobody else has touched the file since last
+ ;; time.
+ (when (and nnfolder-current-buffer
+ (not (gnus-buffer-live-p nnfolder-current-buffer)))
+ (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
+ nnfolder-current-buffer nil))
+
+ (setq nnfolder-current-group group)
+
+ (when (or (not nnfolder-current-buffer)
+ (not (verify-visited-file-modtime nnfolder-current-buffer)))
+ (save-excursion
+ (setq file (nnfolder-group-pathname group))
+ ;; See whether we need to create the new file.
+ (unless (file-exists-p file)
+ (gnus-make-directory (file-name-directory file))
+ (nnmail-write-region 1 1 file t 'nomesg))
+ (when (setq nnfolder-current-buffer (nnfolder-read-folder group))
+ (set-buffer nnfolder-current-buffer)
+ (push (list group nnfolder-current-buffer)
+ nnfolder-buffer-alist)))))))))
+
+(defun nnfolder-save-mail (group-art-list)
+ "Called narrowed to an article."
+ (let* (save-list group-art)
+ (goto-char (point-min))
+ ;; The From line may have been quoted by movemail.
+ (when (looking-at (concat ">" message-unix-mail-delimiter))
+ (delete-char 1))
+ ;; This might come from somewhere else.
+ (unless (looking-at message-unix-mail-delimiter)
+ (insert "From nobody " (current-time-string) "\n")
+ (goto-char (point-min)))
+ ;; Quote all "From " lines in the article.
+ (forward-line 1)
+ (let (case-fold-search)
+ (while (re-search-forward "^From " nil t)
+ (beginning-of-line)
+ (insert "> ")))
+ (setq save-list group-art-list)
+ (nnmail-insert-lines)
+ (nnmail-insert-xref group-art-list)
+ (run-hooks 'nnmail-prepare-save-mail-hook)
+ (run-hooks 'nnfolder-prepare-save-mail-hook)
+
+ ;; Insert the mail into each of the destination groups.
+ (while (setq group-art (pop group-art-list))
+ ;; Kill any previous newsgroup markers.
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (forward-line -1)
+ (while (search-backward (concat "\n" nnfolder-article-marker) nil t)
+ (delete-region (1+ (point)) (progn (forward-line 2) (point))))
+
+ ;; Insert the new newsgroup marker.
+ (nnfolder-insert-newsgroup-line group-art)
+
+ (save-excursion
+ (let ((beg (point-min))
+ (end (point-max))
+ (obuf (current-buffer)))
+ (nnfolder-possibly-change-folder (car group-art))
+ (let ((buffer-read-only nil))
+ (goto-char (point-max))
+ (unless (eolp)
+ (insert "\n"))
+ (unless (bobp)
+ (insert "\n"))
+ (insert-buffer-substring obuf beg end)))))
+
+ ;; Did we save it anywhere?
+ save-list))
+
+(defun nnfolder-insert-newsgroup-line (group-art)
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (insert (format (concat nnfolder-article-marker "%d %s\n")
+ (cdr group-art) (current-time-string))))))
+
+(defun nnfolder-active-number (group)
+ ;; Find the next article number in GROUP.
+ (let ((active (cadr (assoc group nnfolder-group-alist))))
+ (if active
+ (setcdr active (1+ (cdr active)))
+ ;; This group is new, so we create a new entry for it.
+ ;; This might be a bit naughty... creating groups on the drop of
+ ;; a hat, but I don't know...
+ (push (list group (setq active (cons 1 1)))
+ nnfolder-group-alist))
+ (cdr active)))
+
+(defun nnfolder-possibly-change-folder (group)
+ (let ((inf (assoc group nnfolder-buffer-alist)))
+ (if (and inf
+ (gnus-buffer-live-p (cadr inf)))
+ (set-buffer (cadr inf))
+ (when inf
+ (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)))
+ (when nnfolder-group-alist
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file))
+ (push (list group (nnfolder-read-folder group))
+ nnfolder-buffer-alist))))
+
+;; This method has a problem if you've accidentally let the active list get
+;; out of sync with the files. This could happen, say, if you've
+;; accidentally gotten new mail with something other than Gnus (but why
+;; would _that_ ever happen? :-). In that case, we will be in the middle of
+;; processing the file, ready to add new X-Gnus article number markers, and
+;; we'll run across a message with no ID yet - the active list _may_not_ be
+;; ready for us yet.
+
+;; To handle this, I'm modifying this routine to maintain the maximum ID seen
+;; so far, and when we hit a message with no ID, we will _manually_ scan the
+;; rest of the message looking for any more, possibly higher IDs. We'll
+;; assume the maximum that we find is the highest active. Note that this
+;; shouldn't cost us much extra time at all, but will be a lot less
+;; vulnerable to glitches between the mbox and the active file.
+
+(defun nnfolder-read-folder (group)
+ (let* ((file (nnfolder-group-pathname group))
+ (buffer (set-buffer (nnheader-find-file-noselect file))))
+ (if (equal (cadr (assoc group nnfolder-scantime-alist))
+ (nth 5 (file-attributes file)))
+ ;; This looks up-to-date, so we don't do any scanning.
+ buffer
+ ;; Parse the damn thing.
+ (save-excursion
+ (nnmail-activate 'nnfolder)
+ ;; Read in the file.
+ (let ((delim (concat "^" message-unix-mail-delimiter))
+ (marker (concat "\n" nnfolder-article-marker))
+ (number "[0-9]+")
+ (active (or (cadr (assoc group nnfolder-group-alist))
+ (cons 1 0)))
+ (scantime (assoc group nnfolder-scantime-alist))
+ (minid (lsh -1 -1))
+ maxid start end newscantime
+ buffer-read-only)
+ (buffer-disable-undo (current-buffer))
+ (setq maxid (cdr active))
+ (goto-char (point-min))
+
+ ;; Anytime the active number is 1 or 0, it is suspect. In that
+ ;; case, search the file manually to find the active number. Or,
+ ;; of course, if we're being paranoid. (This would also be the
+ ;; place to build other lists from the header markers, such as
+ ;; expunge lists, etc., if we ever desired to abandon the active
+ ;; file entirely for mboxes.)
+ (when (or nnfolder-ignore-active-file
+ (< maxid 2))
+ (while (and (search-forward marker nil t)
+ (re-search-forward number nil t))
+ (let ((newnum (string-to-number (match-string 0))))
+ (setq maxid (max maxid newnum))
+ (setq minid (min minid newnum))))
+ (setcar active (max 1 (min minid maxid)))
+ (setcdr active (max maxid (cdr active)))
+ (goto-char (point-min)))
+
+ ;; As long as we trust that the user will only insert unmarked mail
+ ;; at the end, go to the end and search backwards for the last
+ ;; marker. Find the start of that message, and begin to search for
+ ;; unmarked messages from there.
+ (when (not (or nnfolder-distrust-mbox
+ (< maxid 2)))
+ (goto-char (point-max))
+ (unless (re-search-backward marker nil t)
+ (goto-char (point-min)))
+ (when (nnmail-search-unix-mail-delim)
+ (goto-char (point-min))))
+
+ ;; Keep track of the active number on our own, and insert it back
+ ;; into the active list when we're done. Also, prime the pump to
+ ;; cut down on the number of searches we do.
+ (unless (nnmail-search-unix-mail-delim)
+ (goto-char (point-max)))
+ (setq end (point-marker))
+ (while (not (= end (point-max)))
+ (setq start (marker-position end))
+ (goto-char end)
+ ;; There may be more than one "From " line, so we skip past
+ ;; them.
+ (while (looking-at delim)
+ (forward-line 1))
+ (set-marker end (if (nnmail-search-unix-mail-delim)
+ (point)
+ (point-max)))
+ (goto-char start)
+ (when (not (search-forward marker end t))
+ (narrow-to-region start end)
+ (nnmail-insert-lines)
+ (nnfolder-insert-newsgroup-line
+ (cons nil (nnfolder-active-number nnfolder-current-group)))
+ (widen)))
+
+ (set-marker end nil)
+ ;; Make absolutely sure that the active list reflects reality!
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+ ;; Set the scantime for this group.
+ (setq newscantime (visited-file-modtime))
+ (if scantime
+ (setcdr scantime (list newscantime))
+ (push (list nnfolder-current-group newscantime)
+ nnfolder-scantime-alist))
+ (current-buffer))))))
+
+;;;###autoload
+(defun nnfolder-generate-active-file ()
+ "Look for mbox folders in the nnfolder directory and make them into groups."
+ (interactive)
+ (nnmail-activate 'nnfolder)
+ (let ((files (directory-files nnfolder-directory))
+ file)
+ (while (setq file (pop files))
+ (when (and (not (backup-file-name-p file))
+ (message-mail-file-mbox-p
+ (nnheader-concat nnfolder-directory file)))
+ (let ((oldgroup (assoc file nnfolder-group-alist)))
+ (if oldgroup
+ (nnheader-message 5 "Refreshing group %s..." file)
+ (nnheader-message 5 "Adding group %s..." file))
+ (if oldgroup
+ (setq nnfolder-group-alist
+ (delq oldgroup (copy-sequence nnfolder-group-alist))))
+ (push (list file (cons 1 0)) nnfolder-group-alist)
+ (nnfolder-possibly-change-folder file)
+ (nnfolder-possibly-change-group file)
+ (nnfolder-close-group file))))
+ (message "")))
+
+(defun nnfolder-group-pathname (group)
+ "Make pathname for GROUP."
+ (setq group (gnus-encode-coding-string group nnmail-pathname-coding-system))
+ (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
+ ;; If this file exists, we use it directly.
+ (if (or nnmail-use-long-file-names
+ (file-exists-p (concat dir group)))
+ (concat dir group)
+ ;; If not, we translate dots into slashes.
+ (concat dir (nnheader-replace-chars-in-string group ?. ?/)))))
+
+(defun nnfolder-save-buffer ()
+ "Save the buffer."
+ (when (buffer-modified-p)
+ (run-hooks 'nnfolder-save-buffer-hook)
+ (gnus-make-directory (file-name-directory (buffer-file-name)))
+ (save-buffer)))
+
+(provide 'nnfolder)
+
+;;; nnfolder.el ends here
--- /dev/null
+;;; nngateway.el --- posting news via mail gateways
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnoo)
+(require 'message)
+
+(nnoo-declare nngateway)
+
+(defvoo nngateway-address nil
+ "Address of the mail-to-news gateway.")
+
+(defvoo nngateway-header-transformation 'nngateway-simple-header-transformation
+ "Function to be called to rewrite the news headers into mail headers.
+It is called narrowed to the headers to be transformed with one
+parameter -- the gateway address.")
+
+;;; Interface functions
+
+(nnoo-define-basics nngateway)
+
+(deffoo nngateway-open-server (server &optional defs)
+ (if (nngateway-server-opened server)
+ t
+ (unless (assq 'nngateway-address defs)
+ (setq defs (append defs (list (list 'nngateway-address server)))))
+ (nnoo-change-server 'nngateway server defs)))
+
+(deffoo nngateway-request-post (&optional server)
+ (when (or (nngateway-server-opened server)
+ (nngateway-open-server server))
+ ;; Rewrite the header.
+ (let ((buf (current-buffer)))
+ (nnheader-temp-write nil
+ (insert-buffer-substring buf)
+ (message-narrow-to-head)
+ (funcall nngateway-header-transformation nngateway-address)
+ (goto-char (point-max))
+ (insert mail-header-separator "\n")
+ (widen)
+ (let (message-required-mail-headers)
+ (funcall message-send-mail-function))))))
+
+;;; Internal functions
+
+(defun nngateway-simple-header-transformation (gateway)
+ "Transform the headers to use GATEWAY."
+ (let ((newsgroups (mail-fetch-field "newsgroups")))
+ (message-remove-header "to")
+ (message-remove-header "cc")
+ (goto-char (point-min))
+ (insert "To: " (nnheader-replace-chars-in-string newsgroups ?. ?-)
+ "@" gateway "\n")))
+
+(nnoo-define-skeleton nngateway)
+
+(provide 'nngateway)
+
+;;; nngateway.el ends here
--- /dev/null
+;;; nnheader.el --- header access macros for Gnus and its backends
+;; Copyright (C) 1987,88,89,90,93,94,95,96,97 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; These macros may look very much like the ones in GNUS 4.1. They
+;; are, in a way, but you should note that the indices they use have
+;; been changed from the internal GNUS format to the NOV format. The
+;; makes it possible to read headers from XOVER much faster.
+;;
+;; The format of a header is now:
+;; [number subject from date id references chars lines xref]
+;;
+;; (That last entry is defined as "misc" in the NOV format, but Gnus
+;; uses it for xrefs.)
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'mail-utils)
+
+(defvar nnheader-max-head-length 4096
+ "*Max length of the head of articles.")
+
+(defvar nnheader-head-chop-length 2048
+ "*Length of each read operation when trying to fetch HEAD headers.")
+
+(defvar nnheader-file-name-translation-alist nil
+ "*Alist that says how to translate characters in file names.
+For instance, if \":\" is illegal as a file character in file names
+on your system, you could say something like:
+
+\(setq nnheader-file-name-translation-alist '((?: . ?_)))")
+
+(eval-and-compile
+ (autoload 'nnmail-message-id "nnmail")
+ (autoload 'mail-position-on-field "sendmail")
+ (autoload 'message-remove-header "message")
+ (autoload 'cancel-function-timers "timers")
+ (autoload 'gnus-point-at-eol "gnus-util"))
+
+;;; Header access macros.
+
+(defmacro mail-header-number (header)
+ "Return article number in HEADER."
+ `(aref ,header 0))
+
+(defmacro mail-header-set-number (header number)
+ "Set article number of HEADER to NUMBER."
+ `(aset ,header 0 ,number))
+
+(defmacro mail-header-subject (header)
+ "Return subject string in HEADER."
+ `(aref ,header 1))
+
+(defmacro mail-header-set-subject (header subject)
+ "Set article subject of HEADER to SUBJECT."
+ `(aset ,header 1 ,subject))
+
+(defmacro mail-header-from (header)
+ "Return author string in HEADER."
+ `(aref ,header 2))
+
+(defmacro mail-header-set-from (header from)
+ "Set article author of HEADER to FROM."
+ `(aset ,header 2 ,from))
+
+(defmacro mail-header-date (header)
+ "Return date in HEADER."
+ `(aref ,header 3))
+
+(defmacro mail-header-set-date (header date)
+ "Set article date of HEADER to DATE."
+ `(aset ,header 3 ,date))
+
+(defalias 'mail-header-message-id 'mail-header-id)
+(defmacro mail-header-id (header)
+ "Return Id in HEADER."
+ `(aref ,header 4))
+
+(defalias 'mail-header-set-message-id 'mail-header-set-id)
+(defmacro mail-header-set-id (header id)
+ "Set article Id of HEADER to ID."
+ `(aset ,header 4 ,id))
+
+(defmacro mail-header-references (header)
+ "Return references in HEADER."
+ `(aref ,header 5))
+
+(defmacro mail-header-set-references (header ref)
+ "Set article references of HEADER to REF."
+ `(aset ,header 5 ,ref))
+
+(defmacro mail-header-chars (header)
+ "Return number of chars of article in HEADER."
+ `(aref ,header 6))
+
+(defmacro mail-header-set-chars (header chars)
+ "Set number of chars in article of HEADER to CHARS."
+ `(aset ,header 6 ,chars))
+
+(defmacro mail-header-lines (header)
+ "Return lines in HEADER."
+ `(aref ,header 7))
+
+(defmacro mail-header-set-lines (header lines)
+ "Set article lines of HEADER to LINES."
+ `(aset ,header 7 ,lines))
+
+(defmacro mail-header-xref (header)
+ "Return xref string in HEADER."
+ `(aref ,header 8))
+
+(defmacro mail-header-set-xref (header xref)
+ "Set article xref of HEADER to xref."
+ `(aset ,header 8 ,xref))
+
+(defun make-mail-header (&optional init)
+ "Create a new mail header structure initialized with INIT."
+ (make-vector 9 init))
+
+(defun make-full-mail-header (&optional number subject from date id
+ references chars lines xref)
+ "Create a new mail header structure initialized with the parameters given."
+ (vector number subject from date id references chars lines xref))
+
+;; fake message-ids: generation and detection
+
+(defvar nnheader-fake-message-id 1)
+
+(defsubst nnheader-generate-fake-message-id ()
+ (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id))))
+
+(defsubst nnheader-fake-message-id-p (id)
+ (save-match-data ; regular message-id's are <.*>
+ (string-match "\\`fake\\+none\\+[0-9]+\\'" id)))
+
+;; Parsing headers and NOV lines.
+
+(defsubst nnheader-header-value ()
+ (buffer-substring (match-end 0) (gnus-point-at-eol)))
+
+(defun nnheader-parse-head (&optional naked)
+ (let ((case-fold-search t)
+ (cur (current-buffer))
+ (buffer-read-only nil)
+ in-reply-to lines p)
+ (goto-char (point-min))
+ (when naked
+ (insert "\n"))
+ ;; Search to the beginning of the next header. Error messages
+ ;; do not begin with 2 or 3.
+ (prog1
+ (when (or naked (re-search-forward "^[23][0-9]+ " nil t))
+ ;; This implementation of this function, with nine
+ ;; search-forwards instead of the one re-search-forward and
+ ;; a case (which basically was the old function) is actually
+ ;; about twice as fast, even though it looks messier. You
+ ;; can't have everything, I guess. Speed and elegance
+ ;; don't always go hand in hand.
+ (vector
+ ;; Number.
+ (if naked
+ (progn
+ (setq p (point-min))
+ 0)
+ (prog1
+ (read cur)
+ (end-of-line)
+ (setq p (point))
+ (narrow-to-region (point)
+ (or (and (search-forward "\n.\n" nil t)
+ (- (point) 2))
+ (point)))))
+ ;; Subject.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nsubject: " nil t)
+ (nnheader-header-value) "(none)"))
+ ;; From.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nfrom: " nil t)
+ (nnheader-header-value) "(nobody)"))
+ ;; Date.
+ (progn
+ (goto-char p)
+ (if (search-forward "\ndate: " nil t)
+ (nnheader-header-value) ""))
+ ;; Message-ID.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nmessage-id:" nil t)
+ (buffer-substring
+ (1- (or (search-forward "<" nil t) (point)))
+ (or (search-forward ">" nil t) (point)))
+ ;; If there was no message-id, we just fake one to make
+ ;; subsequent routines simpler.
+ (nnheader-generate-fake-message-id)))
+ ;; References.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nreferences: " nil t)
+ (nnheader-header-value)
+ ;; Get the references from the in-reply-to header if there
+ ;; were no references and the in-reply-to header looks
+ ;; promising.
+ (if (and (search-forward "\nin-reply-to: " nil t)
+ (setq in-reply-to (nnheader-header-value))
+ (string-match "<[^>]+>" in-reply-to))
+ (substring in-reply-to (match-beginning 0)
+ (match-end 0))
+ "")))
+ ;; Chars.
+ 0
+ ;; Lines.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nlines: " nil t)
+ (if (numberp (setq lines (read cur)))
+ lines 0)
+ 0))
+ ;; Xref.
+ (progn
+ (goto-char p)
+ (and (search-forward "\nxref: " nil t)
+ (nnheader-header-value)))))
+ (when naked
+ (goto-char (point-min))
+ (delete-char 1)))))
+
+(defmacro nnheader-nov-skip-field ()
+ '(search-forward "\t" eol 'move))
+
+(defmacro nnheader-nov-field ()
+ '(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol)))
+
+(defmacro nnheader-nov-read-integer ()
+ '(prog1
+ (if (= (following-char) ?\t)
+ 0
+ (let ((num (ignore-errors (read (current-buffer)))))
+ (if (numberp num) num 0)))
+ (or (eobp) (forward-char 1))))
+
+;; (defvar nnheader-none-counter 0)
+
+(defun nnheader-parse-nov ()
+ (let ((eol (gnus-point-at-eol)))
+ (vector
+ (nnheader-nov-read-integer) ; number
+ (nnheader-nov-field) ; subject
+ (nnheader-nov-field) ; from
+ (nnheader-nov-field) ; date
+ (or (nnheader-nov-field)
+ (nnheader-generate-fake-message-id)) ; id
+ (nnheader-nov-field) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
+ (if (= (following-char) ?\n)
+ nil
+ (nnheader-nov-field)) ; misc
+ )))
+
+(defun nnheader-insert-nov (header)
+ (princ (mail-header-number header) (current-buffer))
+ (insert
+ "\t"
+ (or (mail-header-subject header) "(none)") "\t"
+ (or (mail-header-from header) "(nobody)") "\t"
+ (or (mail-header-date header) "") "\t"
+ (or (mail-header-id header)
+ (nnmail-message-id))
+ "\t"
+ (or (mail-header-references header) "") "\t")
+ (princ (or (mail-header-chars header) 0) (current-buffer))
+ (insert "\t")
+ (princ (or (mail-header-lines header) 0) (current-buffer))
+ (insert "\t")
+ (when (mail-header-xref header)
+ (insert "Xref: " (mail-header-xref header) "\t"))
+ (insert "\n"))
+
+(defun nnheader-insert-article-line (article)
+ (goto-char (point-min))
+ (insert "220 ")
+ (princ article (current-buffer))
+ (insert " Article retrieved.\n")
+ (search-forward "\n\n" nil 'move)
+ (delete-region (point) (point-max))
+ (forward-char -1)
+ (insert "."))
+
+(defun nnheader-nov-delete-outside-range (beg end)
+ "Delete all NOV lines that lie outside the BEG to END range."
+ ;; First we find the first wanted line.
+ (nnheader-find-nov-line beg)
+ (delete-region (point-min) (point))
+ ;; Then we find the last wanted line.
+ (when (nnheader-find-nov-line end)
+ (forward-line 1))
+ (delete-region (point) (point-max)))
+
+(defun nnheader-find-nov-line (article)
+ "Put point at the NOV line that start with ARTICLE.
+If ARTICLE doesn't exist, put point where that line
+would have been. The function will return non-nil if
+the line could be found."
+ ;; This function basically does a binary search.
+ (let ((max (point-max))
+ (min (goto-char (point-min)))
+ (cur (current-buffer))
+ (prev (point-min))
+ num found)
+ (while (not found)
+ (goto-char (/ (+ max min) 2))
+ (beginning-of-line)
+ (if (or (= (point) prev)
+ (eobp))
+ (setq found t)
+ (setq prev (point))
+ (while (and (not (numberp (setq num (read cur))))
+ (not (eobp)))
+ (gnus-delete-line))
+ (cond ((> num article)
+ (setq max (point)))
+ ((< num article)
+ (setq min (point)))
+ (t
+ (setq found 'yes)))))
+ ;; We may be at the first line.
+ (when (and (not num)
+ (not (eobp)))
+ (setq num (read cur)))
+ ;; Now we may have found the article we're looking for, or we
+ ;; may be somewhere near it.
+ (when (and (not (eq found 'yes))
+ (not (eq num article)))
+ (setq found (point))
+ (while (and (< (point) max)
+ (or (not (numberp num))
+ (< num article)))
+ (forward-line 1)
+ (setq found (point))
+ (or (eobp)
+ (= (setq num (read cur)) article)))
+ (unless (eq num article)
+ (goto-char found)))
+ (beginning-of-line)
+ (eq num article)))
+
+;; Various cruft the backends and Gnus need to communicate.
+
+(defvar nntp-server-buffer nil)
+(defvar gnus-verbose-backends 7
+ "*A number that says how talkative the Gnus backends should be.")
+(defvar gnus-nov-is-evil nil
+ "If non-nil, Gnus backends will never output headers in the NOV format.")
+(defvar news-reply-yank-from nil)
+(defvar news-reply-yank-message-id nil)
+
+(defvar nnheader-callback-function nil)
+
+(defun nnheader-init-server-buffer ()
+ "Initialize the Gnus-backend communication buffer."
+ (save-excursion
+ (unless (gnus-buffer-live-p nntp-server-buffer)
+ (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
+ (set-buffer nntp-server-buffer)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (kill-all-local-variables)
+ (setq case-fold-search t) ;Should ignore case.
+ t))
+
+;;; Various functions the backends use.
+
+(defun nnheader-file-error (file)
+ "Return a string that says what is wrong with FILE."
+ (format
+ (cond
+ ((not (file-exists-p file))
+ "%s does not exist")
+ ((file-directory-p file)
+ "%s is a directory")
+ ((not (file-readable-p file))
+ "%s is not readable"))
+ file))
+
+(defun nnheader-insert-head (file)
+ "Insert the head of the article."
+ (when (file-exists-p file)
+ (if (eq nnheader-max-head-length t)
+ ;; Just read the entire file.
+ (nnheader-insert-file-contents file)
+ ;; Read 1K blocks until we find a separator.
+ (let ((beg 0)
+ format-alist)
+ (while (and (eq nnheader-head-chop-length
+ (nth 1 (nnheader-insert-file-contents
+ file nil beg
+ (incf beg nnheader-head-chop-length))))
+ (prog1 (not (search-forward "\n\n" nil t))
+ (goto-char (point-max)))
+ (or (null nnheader-max-head-length)
+ (< beg nnheader-max-head-length))))))
+ t))
+
+(defun nnheader-article-p ()
+ "Say whether the current buffer looks like an article."
+ (goto-char (point-min))
+ (if (not (search-forward "\n\n" nil t))
+ nil
+ (narrow-to-region (point-min) (1- (point)))
+ (goto-char (point-min))
+ (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
+ (goto-char (match-end 0)))
+ (prog1
+ (eobp)
+ (widen))))
+
+(defun nnheader-insert-references (references message-id)
+ "Insert a References header based on REFERENCES and MESSAGE-ID."
+ (if (and (not references) (not message-id))
+ () ; This is illegal, but not all articles have Message-IDs.
+ (mail-position-on-field "References")
+ (let ((begin (save-excursion (beginning-of-line) (point)))
+ (fill-column 78)
+ (fill-prefix "\t"))
+ (when references
+ (insert references))
+ (when (and references message-id)
+ (insert " "))
+ (when message-id
+ (insert message-id))
+ ;; Fold long References lines to conform to RFC1036 (sort of).
+ ;; The region must end with a newline to fill the region
+ ;; without inserting extra newline.
+ (fill-region-as-paragraph begin (1+ (point))))))
+
+(defun nnheader-replace-header (header new-value)
+ "Remove HEADER and insert the NEW-VALUE."
+ (save-excursion
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (prog1
+ (message-remove-header header)
+ (goto-char (point-max))
+ (insert header ": " new-value "\n")))))
+
+(defun nnheader-narrow-to-headers ()
+ "Narrow to the head of an article."
+ (widen)
+ (narrow-to-region
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (goto-char (point-min)))
+
+(defun nnheader-set-temp-buffer (name &optional noerase)
+ "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
+ (set-buffer (get-buffer-create name))
+ (buffer-disable-undo (current-buffer))
+ (unless noerase
+ (erase-buffer))
+ (current-buffer))
+
+(defmacro nnheader-temp-write (file &rest forms)
+ "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
+Return the value of FORMS.
+If FILE is nil, just evaluate FORMS and don't save anything.
+If FILE is t, return the buffer contents as a string."
+ (let ((temp-file (make-symbol "temp-file"))
+ (temp-buffer (make-symbol "temp-buffer"))
+ (temp-results (make-symbol "temp-results")))
+ `(save-excursion
+ (let* ((,temp-file ,file)
+ (default-major-mode 'fundamental-mode)
+ (,temp-buffer
+ (set-buffer
+ (get-buffer-create
+ (generate-new-buffer-name " *nnheader temp*"))))
+ ,temp-results)
+ (unwind-protect
+ (progn
+ (setq ,temp-results (progn ,@forms))
+ (cond
+ ;; Don't save anything.
+ ((null ,temp-file)
+ ,temp-results)
+ ;; Return the buffer contents.
+ ((eq ,temp-file t)
+ (set-buffer ,temp-buffer)
+ (buffer-string))
+ ;; Save a file.
+ (t
+ (set-buffer ,temp-buffer)
+ ;; Make sure the directory where this file is
+ ;; to be saved exists.
+ (when (not (file-directory-p
+ (file-name-directory ,temp-file)))
+ (make-directory (file-name-directory ,temp-file) t))
+ ;; Save the file.
+ (write-region (point-min) (point-max)
+ ,temp-file nil 'nomesg)
+ ,temp-results)))
+ ;; Kill the buffer.
+ (when (buffer-name ,temp-buffer)
+ (kill-buffer ,temp-buffer)))))))
+
+(put 'nnheader-temp-write 'lisp-indent-function 1)
+(put 'nnheader-temp-write 'edebug-form-spec '(form body))
+
+(defvar jka-compr-compression-info-list)
+(defvar nnheader-numerical-files
+ (if (boundp 'jka-compr-compression-info-list)
+ (concat "\\([0-9]+\\)\\("
+ (mapconcat (lambda (i) (aref i 0))
+ jka-compr-compression-info-list "\\|")
+ "\\)?")
+ "[0-9]+$")
+ "Regexp that match numerical files.")
+
+(defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files)
+ "Regexp that matches numerical file names.")
+
+(defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files)
+ "Regexp that matches numerical full file paths.")
+
+(defsubst nnheader-file-to-number (file)
+ "Take a file name and return the article number."
+ (if (not (boundp 'jka-compr-compression-info-list))
+ (string-to-int file)
+ (string-match nnheader-numerical-short-files file)
+ (string-to-int (match-string 0 file))))
+
+(defun nnheader-directory-files-safe (&rest args)
+ ;; It has been reported numerous times that `directory-files'
+ ;; fails with an alarming frequency on NFS mounted file systems.
+ ;; This function executes that function twice and returns
+ ;; the longest result.
+ (let ((first (apply 'directory-files args))
+ (second (apply 'directory-files args)))
+ (if (> (length first) (length second))
+ first
+ second)))
+
+(defun nnheader-directory-articles (dir)
+ "Return a list of all article files in a directory."
+ (mapcar 'nnheader-file-to-number
+ (nnheader-directory-files-safe
+ dir nil nnheader-numerical-short-files t)))
+
+(defun nnheader-article-to-file-alist (dir)
+ "Return an alist of article/file pairs in DIR."
+ (mapcar (lambda (file) (cons (nnheader-file-to-number file) file))
+ (nnheader-directory-files-safe
+ dir nil nnheader-numerical-short-files t)))
+
+(defun nnheader-fold-continuation-lines ()
+ "Fold continuation lines in the current buffer."
+ (nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " "))
+
+(defun nnheader-translate-file-chars (file)
+ (if (null nnheader-file-name-translation-alist)
+ ;; No translation is necessary.
+ file
+ ;; We translate -- but only the file name. We leave the directory
+ ;; alone.
+ (let* ((i 0)
+ trans leaf path len)
+ (if (string-match "/[^/]+\\'" file)
+ ;; This is needed on NT's and stuff.
+ (setq leaf (substring file (1+ (match-beginning 0)))
+ path (substring file 0 (1+ (match-beginning 0))))
+ ;; Fall back on this.
+ (setq leaf (file-name-nondirectory file)
+ path (file-name-directory file)))
+ (setq len (length leaf))
+ (while (< i len)
+ (when (setq trans (cdr (assq (aref leaf i)
+ nnheader-file-name-translation-alist)))
+ (aset leaf i trans))
+ (incf i))
+ (concat path leaf))))
+
+(defun nnheader-report (backend &rest args)
+ "Report an error from the BACKEND.
+The first string in ARGS can be a format string."
+ (set (intern (format "%s-status-string" backend))
+ (if (< (length args) 2)
+ (car args)
+ (apply 'format args)))
+ nil)
+
+(defun nnheader-get-report (backend)
+ "Get the most recent report from BACKEND."
+ (condition-case ()
+ (message "%s" (symbol-value (intern (format "%s-status-string"
+ backend))))
+ (error (message ""))))
+
+(defun nnheader-insert (format &rest args)
+ "Clear the communication buffer and insert FORMAT and ARGS into the buffer.
+If FORMAT isn't a format string, it and all ARGS will be inserted
+without formatting."
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (if (string-match "%" format)
+ (insert (apply 'format format args))
+ (apply 'insert format args))
+ t))
+
+(defun nnheader-replace-chars-in-string (string from to)
+ "Replace characters in STRING from FROM to TO."
+ (let ((string (substring string 0)) ;Copy string.
+ (len (length string))
+ (idx 0))
+ ;; Replace all occurrences of FROM with TO.
+ (while (< idx len)
+ (when (= (aref string idx) from)
+ (aset string idx to))
+ (setq idx (1+ idx)))
+ string))
+
+(defun nnheader-file-to-group (file &optional top)
+ "Return a group name based on FILE and TOP."
+ (nnheader-replace-chars-in-string
+ (if (not top)
+ file
+ (condition-case ()
+ (substring (expand-file-name file)
+ (length
+ (expand-file-name
+ (file-name-as-directory top))))
+ (error "")))
+ ?/ ?.))
+
+(defun nnheader-message (level &rest args)
+ "Message if the Gnus backends are talkative."
+ (if (or (not (numberp gnus-verbose-backends))
+ (<= level gnus-verbose-backends))
+ (apply 'message args)
+ (apply 'format args)))
+
+(defun nnheader-be-verbose (level)
+ "Return whether the backends should be verbose on LEVEL."
+ (or (not (numberp gnus-verbose-backends))
+ (<= level gnus-verbose-backends)))
+
+(defvar nnheader-pathname-coding-system 'iso-8859-1
+ "*Coding system for pathname.")
+
+(defun nnheader-group-pathname (group dir &optional file)
+ "Make pathname for GROUP."
+ (concat
+ (let ((dir (file-name-as-directory (expand-file-name dir))))
+ ;; If this directory exists, we use it directly.
+ (if (file-directory-p (concat dir group))
+ (concat dir group "/")
+ ;; If not, we translate dots into slashes.
+ (concat dir
+ (gnus-encode-coding-string
+ (nnheader-replace-chars-in-string group ?. ?/)
+ nnheader-pathname-coding-system)
+ "/")))
+ (cond ((null file) "")
+ ((numberp file) (int-to-string file))
+ (t file))))
+
+(defun nnheader-functionp (form)
+ "Return non-nil if FORM is funcallable."
+ (or (and (symbolp form) (fboundp form))
+ (and (listp form) (eq (car form) 'lambda))))
+
+(defun nnheader-concat (dir &rest files)
+ "Concat DIR as directory to FILE."
+ (apply 'concat (file-name-as-directory dir) files))
+
+(defun nnheader-ms-strip-cr ()
+ "Strip ^M from the end of all lines."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "\r$" nil t)
+ (delete-backward-char 1))))
+
+(defun nnheader-file-size (file)
+ "Return the file size of FILE or 0."
+ (or (nth 7 (file-attributes file)) 0))
+
+(defun nnheader-find-etc-directory (package &optional file)
+ "Go through the path and find the \".../etc/PACKAGE\" directory.
+If FILE, find the \".../etc/PACKAGE\" file instead."
+ (let ((path load-path)
+ dir result)
+ ;; We try to find the dir by looking at the load path,
+ ;; stripping away the last component and adding "etc/".
+ (while path
+ (if (and (car path)
+ (file-exists-p
+ (setq dir (concat
+ (file-name-directory
+ (directory-file-name (car path)))
+ "etc/" package
+ (if file "" "/"))))
+ (or file (file-directory-p dir)))
+ (setq result dir
+ path nil)
+ (setq path (cdr path))))
+ result))
+
+(defvar ange-ftp-path-format)
+(defvar efs-path-regexp)
+(defun nnheader-re-read-dir (path)
+ "Re-read directory PATH if PATH is on a remote system."
+ (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp))
+ (when (string-match efs-path-regexp path)
+ (efs-re-read-dir path))
+ (when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format))
+ (when (string-match (car ange-ftp-path-format) path)
+ (ange-ftp-re-read-dir path)))))
+
+;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+(defvar nnheader-file-coding-system nil
+ "Coding system used in file backends of Gnus.")
+
+(defun nnheader-insert-file-contents (filename &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but only reads in the file.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+ This function ensures that none of these modifications will take place."
+ (let ((format-alist nil)
+ (auto-mode-alist (nnheader-auto-mode-alist))
+ (default-major-mode 'fundamental-mode)
+ (after-insert-file-functions nil)
+ ;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ (coding-system-for-read nnheader-file-coding-system))
+ (insert-file-contents filename visit beg end replace)))
+
+(defun nnheader-find-file-noselect (&rest args)
+ (let ((format-alist nil)
+ (auto-mode-alist (nnheader-auto-mode-alist))
+ (default-major-mode 'fundamental-mode)
+ (enable-local-variables nil)
+ (after-insert-file-functions nil)
+ ;; 1997/5/16 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ (coding-system-for-read nnheader-file-coding-system))
+ (apply 'find-file-noselect args)))
+
+(defun nnheader-auto-mode-alist ()
+ "Return an `auto-mode-alist' with only the .gz (etc) thingies."
+ (let ((alist auto-mode-alist)
+ out)
+ (while alist
+ (when (listp (cdar alist))
+ (push (car alist) out))
+ (pop alist))
+ (nreverse out)))
+
+(defun nnheader-directory-regular-files (dir)
+ "Return a list of all regular files in DIR."
+ (let ((files (directory-files dir t))
+ out)
+ (while files
+ (when (file-regular-p (car files))
+ (push (car files) out))
+ (pop files))
+ (nreverse out)))
+
+(defmacro nnheader-skeleton-replace (from &optional to regexp)
+ `(let ((new (generate-new-buffer " *nnheader replace*"))
+ (cur (current-buffer))
+ (start (point-min)))
+ (set-buffer new)
+ (buffer-disable-undo (current-buffer))
+ (set-buffer cur)
+ (goto-char (point-min))
+ (while (,(if regexp 're-search-forward 'search-forward)
+ ,from nil t)
+ (insert-buffer-substring
+ cur start (prog1 (match-beginning 0) (set-buffer new)))
+ (goto-char (point-max))
+ ,(when to `(insert ,to))
+ (set-buffer cur)
+ (setq start (point)))
+ (insert-buffer-substring
+ cur start (prog1 (point-max) (set-buffer new)))
+ (copy-to-buffer cur (point-min) (point-max))
+ (kill-buffer (current-buffer))
+ (set-buffer cur)))
+
+(defun nnheader-replace-string (from to)
+ "Do a fast replacement of FROM to TO from point to point-max."
+ (nnheader-skeleton-replace from to))
+
+(defun nnheader-replace-regexp (from to)
+ "Do a fast regexp replacement of FROM to TO from point to point-max."
+ (nnheader-skeleton-replace from to t))
+
+(defun nnheader-strip-cr ()
+ "Strip all \r's from the current buffer."
+ (nnheader-skeleton-replace "\r"))
+
+(fset 'nnheader-run-at-time 'run-at-time)
+(fset 'nnheader-cancel-timer 'cancel-timer)
+(fset 'nnheader-cancel-function-timers 'cancel-function-timers)
+
+(when (string-match "XEmacs\\|Lucid" emacs-version)
+ (require 'nnheaderxm))
+
+(run-hooks 'nnheader-load-hook)
+
+(provide 'nnheader)
+
+;;; nnheader.el ends here
--- /dev/null
+;;; nnheaderxm.el --- making Gnus backends work under XEmacs
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(defun nnheader-xmas-run-at-time (time repeat function &rest args)
+ (start-itimer
+ "nnheader-run-at-time"
+ `(lambda ()
+ (,function ,@args))
+ time repeat))
+
+(fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time)
+(fset 'nnheader-cancel-timer 'delete-itimer)
+(fset 'nnheader-cancel-function-timers 'ignore)
+
+(provide 'nnheaderxm)
+
+;;; nnheaderxm.el ends here.
--- /dev/null
+;;; nnkiboze.el --- select virtual news access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; The other access methods (nntp, nnspool, etc) are general news
+;; access methods. This module relies on Gnus and can't be used
+;; separately.
+
+;;; Code:
+
+(require 'nntp)
+(require 'nnheader)
+(require 'gnus)
+(require 'gnus-score)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nnkiboze)
+(defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/")
+ "nnkiboze will put its files in this directory.")
+
+(defvoo nnkiboze-level 9
+ "The maximum level to be searched for articles.")
+
+(defvoo nnkiboze-remove-read-articles t
+ "If non-nil, nnkiboze will remove read articles from the kiboze group.")
+
+(defvoo nnkiboze-ephemeral nil
+ "If non-nil, don't store any data anywhere.")
+
+(defvoo nnkiboze-scores nil
+ "Score rules for generating the nnkiboze group.")
+
+(defvoo nnkiboze-regexp nil
+ "Regexp for matching component groups.")
+
+\f
+
+(defconst nnkiboze-version "nnkiboze 1.0")
+
+(defvoo nnkiboze-current-group nil)
+(defvoo nnkiboze-status-string "")
+
+(defvoo nnkiboze-headers nil)
+
+\f
+
+;;; Interface functions.
+
+(nnoo-define-basics nnkiboze)
+
+(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old)
+ (nnkiboze-possibly-change-group group)
+ (unless gnus-nov-is-evil
+ (if (stringp (car articles))
+ 'headers
+ (let ((nov (nnkiboze-nov-file-name)))
+ (when (file-exists-p nov)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (nnheader-insert-file-contents nov)
+ (nnheader-nov-delete-outside-range
+ (car articles) (car (last articles)))
+ 'nov))))))
+
+(deffoo nnkiboze-request-article (article &optional newsgroup server buffer)
+ (nnkiboze-possibly-change-group newsgroup)
+ (if (not (numberp article))
+ ;; This is a real kludge. It might not work at times, but it
+ ;; does no harm I think. The only alternative is to offer no
+ ;; article fetching by message-id at all.
+ (nntp-request-article article newsgroup gnus-nntp-server buffer)
+ (let* ((header (gnus-summary-article-header article))
+ (xref (mail-header-xref header)))
+ (unless xref
+ (error "nnkiboze: No xref"))
+ (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
+ (error "nnkiboze: Malformed xref"))
+ (gnus-request-article (string-to-int (match-string 2 xref))
+ (match-string 1 xref)
+ buffer))))
+
+(deffoo nnkiboze-request-scan (&optional group server)
+ (nnkiboze-generate-group (concat "nnkiboze:" group)))
+
+(deffoo nnkiboze-request-group (group &optional server dont-check)
+ "Make GROUP the current newsgroup."
+ (nnkiboze-possibly-change-group group)
+ (if dont-check
+ t
+ (let ((nov-file (nnkiboze-nov-file-name))
+ beg end total)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (if (not (file-exists-p nov-file))
+ (nnheader-report 'nnkiboze "Can't select group %s" group)
+ (nnheader-insert-file-contents nov-file)
+ (if (zerop (buffer-size))
+ (nnheader-insert "211 0 0 0 %s\n" group)
+ (goto-char (point-min))
+ (when (looking-at "[0-9]+")
+ (setq beg (read (current-buffer))))
+ (goto-char (point-max))
+ (when (re-search-backward "^[0-9]" nil t)
+ (setq end (read (current-buffer))))
+ (setq total (count-lines (point-min) (point-max)))
+ (nnheader-insert "211 %d %d %d %s\n" total beg end group)))))))
+
+(deffoo nnkiboze-close-group (group &optional server)
+ (nnkiboze-possibly-change-group group)
+ ;; Remove NOV lines of articles that are marked as read.
+ (when (and (file-exists-p (nnkiboze-nov-file-name))
+ nnkiboze-remove-read-articles)
+ (nnheader-temp-write (nnkiboze-nov-file-name)
+ (let ((cur (current-buffer)))
+ (nnheader-insert-file-contents (nnkiboze-nov-file-name))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (not (gnus-article-read-p (read cur)))
+ (forward-line 1)
+ (gnus-delete-line))))))
+ (setq nnkiboze-current-group nil))
+
+(deffoo nnkiboze-open-server (server &optional defs)
+ (unless (assq 'nnkiboze-regexp defs)
+ (push `(nnkiboze-regexp ,server)
+ defs))
+ (nnoo-change-server 'nnkiboze server defs))
+
+(deffoo nnkiboze-request-delete-group (group &optional force server)
+ (nnkiboze-possibly-change-group group)
+ (when force
+ (let ((files (list (nnkiboze-nov-file-name)
+ (concat nnkiboze-directory
+ (nnheader-translate-file-chars
+ (concat group ".newsrc")))
+ (nnkiboze-score-file group))))
+ (while files
+ (and (file-exists-p (car files))
+ (file-writable-p (car files))
+ (delete-file (car files)))
+ (setq files (cdr files)))))
+ (setq nnkiboze-current-group nil))
+
+(nnoo-define-skeleton nnkiboze)
+
+\f
+;;; Internal functions.
+
+(defun nnkiboze-possibly-change-group (group)
+ (setq nnkiboze-current-group group))
+
+(defun nnkiboze-prefixed-name (group)
+ (gnus-group-prefixed-name group '(nnkiboze "")))
+
+;;;###autoload
+(defun nnkiboze-generate-groups ()
+ "Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups
+Finds out what articles are to be part of the nnkiboze groups."
+ (interactive)
+ (let ((nnmail-spool-file nil)
+ (gnus-use-dribble-file nil)
+ (gnus-read-active-file t)
+ (gnus-expert-user t))
+ (gnus))
+ (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist))
+ (newsrc (cdr gnus-newsrc-alist))
+ gnus-newsrc-hashtb info)
+ (gnus-make-hashtable-from-newsrc-alist)
+ ;; We have copied all the newsrc alist info over to local copies
+ ;; so that we can mess all we want with these lists.
+ (while (setq info (pop newsrc))
+ (when (string-match "nnkiboze" (gnus-info-group info))
+ ;; For each kiboze group, we call this function to generate
+ ;; it.
+ (nnkiboze-generate-group (gnus-info-group info))))))
+
+(defun nnkiboze-score-file (group)
+ (list (expand-file-name
+ (concat (file-name-as-directory gnus-kill-files-directory)
+ (nnheader-translate-file-chars
+ (concat (nnkiboze-prefixed-name nnkiboze-current-group)
+ "." gnus-score-file-suffix))))))
+
+(defun nnkiboze-generate-group (group)
+ (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
+ (newsrc-file (concat nnkiboze-directory
+ (nnheader-translate-file-chars
+ (concat group ".newsrc"))))
+ (nov-file (concat nnkiboze-directory
+ (nnheader-translate-file-chars
+ (concat group ".nov"))))
+ method nnkiboze-newsrc gname newsrc active
+ ginfo lowest glevel orig-info nov-buffer
+ ;; Bind various things to nil to make group entry faster.
+ (gnus-expert-user t)
+ (gnus-large-newsgroup nil)
+ (gnus-score-find-score-files-function 'nnkiboze-score-file)
+ (gnus-verbose (min gnus-verbose 3))
+ gnus-select-group-hook gnus-summary-prepare-hook
+ gnus-thread-sort-functions gnus-show-threads
+ gnus-visual gnus-suppress-duplicates)
+ (unless info
+ (error "No such group: %s" group))
+ ;; Load the kiboze newsrc file for this group.
+ (when (file-exists-p newsrc-file)
+ (load newsrc-file))
+ (nnheader-temp-write nov-file
+ (when (file-exists-p nov-file)
+ (insert-file-contents nov-file))
+ (setq nov-buffer (current-buffer))
+ ;; Go through the active hashtb and add new all groups that match the
+ ;; kiboze regexp.
+ (mapatoms
+ (lambda (group)
+ (and (string-match nnkiboze-regexp
+ (setq gname (symbol-name group))) ; Match
+ (not (assoc gname nnkiboze-newsrc)) ; It isn't registered
+ (numberp (car (symbol-value group))) ; It is active
+ (or (> nnkiboze-level 7)
+ (and (setq glevel (nth 1 (nth 2 (gnus-gethash
+ gname gnus-newsrc-hashtb))))
+ (>= nnkiboze-level glevel)))
+ (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
+ (push (cons gname (1- (car (symbol-value group))))
+ nnkiboze-newsrc)))
+ gnus-active-hashtb)
+ ;; `newsrc' is set to the list of groups that possibly are
+ ;; component groups to this kiboze group. This list has elements
+ ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
+ ;; number that has been kibozed in GROUP in this kiboze group.
+ (setq newsrc nnkiboze-newsrc)
+ (while newsrc
+ (if (not (setq active (gnus-gethash
+ (caar newsrc) gnus-active-hashtb)))
+ ;; This group isn't active after all, so we remove it from
+ ;; the list of component groups.
+ (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
+ (setq lowest (cdar newsrc))
+ ;; Ok, we have a valid component group, so we jump to it.
+ (switch-to-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group (caar newsrc))
+ (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
+ (setq ginfo (gnus-get-info (gnus-group-group-name))
+ orig-info (gnus-copy-sequence ginfo))
+ (unwind-protect
+ (progn
+ ;; We set all list of article marks to nil. Since we operate
+ ;; on copies of the real lists, we can destroy anything we
+ ;; want here.
+ (when (nth 3 ginfo)
+ (setcar (nthcdr 3 ginfo) nil))
+ ;; We set the list of read articles to be what we expect for
+ ;; this kiboze group -- either nil or `(1 . LOWEST)'.
+ (when ginfo
+ (setcar (nthcdr 2 ginfo)
+ (and (not (= lowest 1)) (cons 1 lowest))))
+ (when (and (or (not ginfo)
+ (> (length (gnus-list-of-unread-articles
+ (car ginfo)))
+ 0))
+ (progn
+ (ignore-errors
+ (gnus-group-select-group nil))
+ (eq major-mode 'gnus-summary-mode)))
+ ;; We are now in the group where we want to be.
+ (setq method (gnus-find-method-for-group
+ gnus-newsgroup-name))
+ (when (eq method gnus-select-method)
+ (setq method nil))
+ ;; We go through the list of scored articles.
+ (while gnus-newsgroup-scored
+ (when (> (caar gnus-newsgroup-scored) lowest)
+ ;; If it has a good score, then we enter this article
+ ;; into the kiboze group.
+ (nnkiboze-enter-nov
+ nov-buffer
+ (gnus-summary-article-header
+ (caar gnus-newsgroup-scored))
+ gnus-newsgroup-name))
+ (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
+ ;; That's it. We exit this group.
+ (gnus-summary-exit-no-update)))
+ ;; Restore the proper info.
+ (when ginfo
+ (setcdr ginfo (cdr orig-info)))))
+ (setcdr (car newsrc) (car active))
+ (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
+ (setq newsrc (cdr newsrc))))
+ ;; We save the kiboze newsrc for this group.
+ (nnheader-temp-write newsrc-file
+ (insert "(setq nnkiboze-newsrc '")
+ (gnus-prin1 nnkiboze-newsrc)
+ (insert ")\n"))
+ t))
+
+(defun nnkiboze-enter-nov (buffer header group)
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-max))
+ (let ((xref (mail-header-xref header))
+ (prefix (gnus-group-real-prefix group))
+ (oheader (copy-sequence header))
+ (first t)
+ article)
+ (if (zerop (forward-line -1))
+ (progn
+ (setq article (1+ (read (current-buffer))))
+ (forward-line 1))
+ (setq article 1))
+ (mail-header-set-number oheader article)
+ (nnheader-insert-nov oheader)
+ (search-backward "\t" nil t 2)
+ (if (re-search-forward " [^ ]+:[0-9]+" nil t)
+ (goto-char (match-beginning 0))
+ (forward-char 1))
+ ;; The first Xref has to be the group this article
+ ;; really came for - this is the article nnkiboze
+ ;; will request when it is asked for the article.
+ (insert group ":"
+ (int-to-string (mail-header-number header)) " ")
+ (while (re-search-forward " [^ ]+:[0-9]+" nil t)
+ (goto-char (1+ (match-beginning 0)))
+ (insert prefix)))))
+
+(defun nnkiboze-nov-file-name ()
+ (concat (file-name-as-directory nnkiboze-directory)
+ (nnheader-translate-file-chars
+ (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov"))))
+
+(provide 'nnkiboze)
+
+;;; nnkiboze.el ends here
--- /dev/null
+;;; nnmail.el --- mail support functions for the Gnus mail backends
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'nnheader)
+(require 'timezone)
+(require 'message)
+(require 'custom)
+
+(eval-and-compile
+ (autoload 'gnus-error "gnus-util"))
+
+(defgroup nnmail nil
+ "Reading mail with Gnus."
+ :group 'gnus)
+
+(defgroup nnmail-retrieve nil
+ "Retrieving new mail."
+ :group 'nnmail)
+
+(defgroup nnmail-prepare nil
+ "Preparing (or mangling) new mail after retrival."
+ :group 'nnmail)
+
+(defgroup nnmail-duplicate nil
+ "Handling of duplicate mail messages."
+ :group 'nnmail)
+
+(defgroup nnmail-split nil
+ "Organizing the incomming mail in folders."
+ :group 'nnmail)
+
+(defgroup nnmail-files nil
+ "Mail files."
+ :group 'gnus-files
+ :group 'nnmail)
+
+(defgroup nnmail-expire nil
+ "Expiring old mail."
+ :group 'nnmail)
+
+(defgroup nnmail-procmail nil
+ "Interfacing with procmail and other mail agents."
+ :group 'nnmail)
+
+(defgroup nnmail-various nil
+ "Various mail options."
+ :group 'nnmail)
+
+(defcustom nnmail-split-methods
+ '(("mail.misc" ""))
+ "Incoming mail will be split according to this variable.
+
+If you'd like, for instance, one mail group for mail from the
+\"4ad-l\" mailing list, one group for junk mail and one for everything
+else, you could do something like this:
+
+ (setq nnmail-split-methods
+ '((\"mail.4ad\" \"From:.*4ad\")
+ (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
+ (\"mail.misc\" \"\")))
+
+As you can see, this variable is a list of lists, where the first
+element in each \"rule\" is the name of the group (which, by the way,
+does not have to be called anything beginning with \"mail\",
+\"yonka.zow\" is a fine, fine name), and the second is a regexp that
+nnmail will try to match on the header to find a fit.
+
+The second element can also be a function. In that case, it will be
+called narrowed to the headers with the first element of the rule as
+the argument. It should return a non-nil value if it thinks that the
+mail belongs in that group.
+
+The last element should always have \"\" as the regexp.
+
+This variable can also have a function as its value."
+ :group 'nnmail-split
+ :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
+ (function-item nnmail-split-fancy)
+ (function :tag "Other")))
+
+;; Suggested by Erik Selberg <speed@cs.washington.edu>.
+(defcustom nnmail-crosspost t
+ "If non-nil, do crossposting if several split methods match the mail.
+If nil, the first match found will be used."
+ :group 'nnmail-split
+ :type 'boolean)
+
+;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
+(defcustom nnmail-keep-last-article nil
+ "If non-nil, nnmail will never delete/move a group's last article.
+It can be marked expirable, so it will be deleted when it is no longer last.
+
+You may need to set this variable if other programs are putting
+new mail into folder numbers that Gnus has marked as expired."
+ :group 'nnmail-procmail
+ :group 'nnmail-various
+ :type 'boolean)
+
+(defcustom nnmail-use-long-file-names nil
+ "If non-nil the mail backends will use long file and directory names.
+If nil, groups like \"mail.misc\" will end up in directories like
+\"mail/misc/\"."
+ :group 'nnmail-files
+ :type 'boolean)
+
+(defcustom nnmail-default-file-modes 384
+ "Set the mode bits of all new mail files to this integer."
+ :group 'nnmail-files
+ :type 'integer)
+
+(defcustom nnmail-expiry-wait 7
+ "*Expirable articles that are older than this will be expired.
+This variable can either be a number (which will be interpreted as a
+number of days) -- this doesn't have to be an integer. This variable
+can also be `immediate' and `never'."
+ :group 'nnmail-expire
+ :type '(choice (const immediate)
+ (integer :tag "days")
+ (const never)))
+
+(defcustom nnmail-expiry-wait-function nil
+ "Variable that holds function to specify how old articles should be before they are expired.
+ The function will be called with the name of the group that the
+expiry is to be performed in, and it should return an integer that
+says how many days an article can be stored before it is considered
+\"old\". It can also return the values `never' and `immediate'.
+
+Eg.:
+
+\(setq nnmail-expiry-wait-function
+ (lambda (newsgroup)
+ (cond ((string-match \"private\" newsgroup) 31)
+ ((string-match \"junk\" newsgroup) 1)
+ ((string-match \"important\" newsgroup) 'never)
+ (t 7))))"
+ :group 'nnmail-expire
+ :type '(choice (const :tag "nnmail-expiry-wait" nil)
+ (function :format "%v" nnmail-)))
+
+(defcustom nnmail-cache-accepted-message-ids nil
+ "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache."
+ :group 'nnmail
+ :type 'boolean)
+
+(defcustom nnmail-spool-file
+ (or (getenv "MAIL")
+ (concat "/usr/spool/mail/" (user-login-name)))
+ "Where the mail backends will look for incoming mail.
+This variable is \"/usr/spool/mail/$user\" by default.
+If this variable is nil, no mail backends will read incoming mail.
+If this variable is a list, all files mentioned in this list will be
+used as incoming mailboxes.
+If this variable is a directory (i. e., it's name ends with a \"/\"),
+treat all files in that directory as incoming spool files."
+ :group 'nnmail-files
+ :type 'file)
+
+(defcustom nnmail-crash-box "~/.gnus-crash-box"
+ "File where Gnus will store mail while processing it."
+ :group 'nnmail-files
+ :type 'file)
+
+(defcustom nnmail-use-procmail nil
+ "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
+The file(s) in `nnmail-spool-file' will also be read."
+ :group 'nnmail-procmail
+ :type 'boolean)
+
+(defcustom nnmail-procmail-directory "~/incoming/"
+ "*When using procmail (and the like), incoming mail is put in this directory.
+The Gnus mail backends will read the mail from this directory."
+ :group 'nnmail-procmail
+ :type 'directory)
+
+(defcustom nnmail-procmail-suffix "\\.spool"
+ "*Suffix of files created by procmail (and the like).
+This variable might be a suffix-regexp to match the suffixes of
+several files - eg. \".spool[0-9]*\"."
+ :group 'nnmail-procmail
+ :type 'regexp)
+
+(defcustom nnmail-resplit-incoming nil
+ "*If non-nil, re-split incoming procmail sorted mail."
+ :group 'nnmail-procmail
+ :type 'boolean)
+
+(defcustom nnmail-delete-file-function 'delete-file
+ "Function called to delete files in some mail backends."
+ :group 'nnmail-files
+ :type 'function)
+
+(defcustom nnmail-crosspost-link-function
+ (if (string-match "windows-nt\\|emx" (format "%s" system-type))
+ 'copy-file
+ 'add-name-to-file)
+ "Function called to create a copy of a file.
+This is `add-name-to-file' by default, which means that crossposts
+will use hard links. If your file system doesn't allow hard
+links, you could set this variable to `copy-file' instead."
+ :group 'nnmail-files
+ :type '(radio (function-item add-name-to-file)
+ (function-item copy-file)
+ (function :tag "Other")))
+
+(defcustom nnmail-movemail-program "movemail"
+ "*A command to be executed to move mail from the inbox.
+The default is \"movemail\".
+
+This can also be a function. In that case, the function will be
+called with two parameters -- the name of the INBOX file, and the file
+to be moved to."
+ :group 'nnmail-files
+ :group 'nnmail-retrieve
+ :type 'string)
+
+(defcustom nnmail-pop-password-required nil
+ "*Non-nil if a password is required when reading mail using POP."
+ :group 'nnmail-retrieve
+ :type 'boolean)
+
+(defcustom nnmail-read-incoming-hook
+ (if (eq system-type 'windows-nt)
+ '(nnheader-ms-strip-cr)
+ nil)
+ "Hook that will be run after the incoming mail has been transferred.
+The incoming mail is moved from `nnmail-spool-file' (which normally is
+something like \"/usr/spool/mail/$user\") to the user's home
+directory. This hook is called after the incoming mail box has been
+emptied, and can be used to call any mail box programs you have
+running (\"xwatch\", etc.)
+
+Eg.
+
+\(add-hook 'nnmail-read-incoming-hook
+ (lambda ()
+ (start-process \"mailsend\" nil
+ \"/local/bin/mailsend\" \"read\" \"mbox\")))
+
+If you have xwatch running, this will alert it that mail has been
+read.
+
+If you use `display-time', you could use something like this:
+
+\(add-hook 'nnmail-read-incoming-hook
+ (lambda ()
+ ;; Update the displayed time, since that will clear out
+ ;; the flag that says you have mail.
+ (when (eq (process-status \"display-time\") 'run)
+ (display-time-filter display-time-process \"\"))))"
+ :group 'nnmail-prepare
+ :type 'hook)
+
+;; Suggested by Erik Selberg <speed@cs.washington.edu>.
+(defcustom nnmail-prepare-incoming-hook nil
+ "Hook called before treating incoming mail.
+The hook is run in a buffer with all the new, incoming mail."
+ :group 'nnmail-prepare
+ :type 'hook)
+
+(defcustom nnmail-prepare-incoming-header-hook nil
+ "Hook called narrowed to the headers of each message.
+This can be used to remove excessive spaces (and stuff like
+that) from the headers before splitting and saving the messages."
+ :group 'nnmail-prepare
+ :type 'hook)
+
+(defcustom nnmail-prepare-incoming-message-hook nil
+ "Hook called narrowed to each message."
+ :group 'nnmail-prepare
+ :type 'hook)
+
+(defcustom nnmail-list-identifiers nil
+ "Regexp that matches list identifiers to be removed.
+This can also be a list of regexps."
+ :group 'nnmail-prepare
+ :type '(choice (const :tag "none" nil)
+ regexp
+ (repeat regexp)))
+
+(defcustom nnmail-pre-get-new-mail-hook nil
+ "Hook called just before starting to handle new incoming mail."
+ :group 'nnmail-retrieve
+ :type 'hook)
+
+(defcustom nnmail-post-get-new-mail-hook nil
+ "Hook called just after finishing handling new incoming mail."
+ :group 'nnmail-retrieve
+ :type 'hook)
+
+(defcustom nnmail-split-hook nil
+ "Hook called before deciding where to split an article.
+The functions in this hook are free to modify the buffer
+contents in any way they choose -- the buffer contents are
+discarded after running the split process."
+ :group 'nnmail-split
+ :type 'hook)
+
+;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
+(defcustom nnmail-tmp-directory nil
+ "*If non-nil, use this directory for temporary storage.
+Used when reading incoming mail."
+ :group 'nnmail-files
+ :group 'nnmail-retrieve
+ :type '(choice (const :tag "default" nil)
+ (directory :format "%v")))
+
+(defcustom nnmail-large-newsgroup 50
+ "*The number of the articles which indicates a large newsgroup.
+If the number of the articles is greater than the value, verbose
+messages will be shown to indicate the current status."
+ :group 'nnmail-various
+ :type 'integer)
+
+(defcustom nnmail-split-fancy "mail.misc"
+ "Incoming mail can be split according to this fancy variable.
+To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
+
+The format is this variable is SPLIT, where SPLIT can be one of
+the following:
+
+GROUP: Mail will be stored in GROUP (a string).
+
+\(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
+ VALUE (a regexp), store the messages as specified by SPLIT.
+
+\(| SPLIT...): Process each SPLIT expression until one of them matches.
+ A SPLIT expression is said to match if it will cause the mail
+ message to be stored in one or more groups.
+
+\(& SPLIT...): Process each SPLIT expression.
+
+\(: FUNCTION optional args): Call FUNCTION with the optional args, in
+ the buffer containing the message headers. The return value FUNCTION
+ should be a split, which is then recursively processed.
+
+FIELD must match a complete field name. VALUE must match a complete
+word according to the `nnmail-split-fancy-syntax-table' syntax table.
+You can use \".*\" in the regexps to match partial field names or words.
+
+FIELD and VALUE can also be lisp symbols, in that case they are expanded
+as specified in `nnmail-split-abbrev-alist'.
+
+GROUP can contain \\& and \\N which will substitute from matching
+\\(\\) patterns in the previous VALUE.
+
+Example:
+
+\(setq nnmail-split-methods 'nnmail-split-fancy
+ nnmail-split-fancy
+ ;; Messages from the mailer daemon are not crossposted to any of
+ ;; the ordinary groups. Warnings are put in a separate group
+ ;; from real errors.
+ '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
+ \"mail.misc\"))
+ ;; Non-error messages are crossposted to all relevant
+ ;; groups, but we don't crosspost between the group for the
+ ;; (ding) list and the group for other (ding) related mail.
+ (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
+ (\"subject\" \"ding\" \"ding.misc\"))
+ ;; Other mailing lists...
+ (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
+ (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
+ ;; People...
+ (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
+ ;; Unmatched mail goes to the catch all group.
+ \"misc.misc\"))"
+ :group 'nnmail-split
+ ;; Sigh!
+ :type 'sexp)
+
+(defcustom nnmail-split-abbrev-alist
+ '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
+ (mail . "mailer-daemon\\|postmaster\\|uucp")
+ (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
+ (from . "from\\|sender\\|resent-from")
+ (nato . "to\\|cc\\|resent-to\\|resent-cc")
+ (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
+ "Alist of abbreviations allowed in `nnmail-split-fancy'."
+ :group 'nnmail-split
+ :type '(repeat (cons :format "%v" symbol regexp)))
+
+(defcustom nnmail-delete-incoming t
+ "*If non-nil, the mail backends will delete incoming files after
+splitting."
+ :group 'nnmail-retrieve
+ :type 'boolean)
+
+(defcustom nnmail-message-id-cache-length 1000
+ "*The approximate number of Message-IDs nnmail will keep in its cache.
+If this variable is nil, no checking on duplicate messages will be
+performed."
+ :group 'nnmail-duplicate
+ :type '(choice (const :tag "disable" nil)
+ (integer :format "%v")))
+
+(defcustom nnmail-message-id-cache-file "~/.nnmail-cache"
+ "*The file name of the nnmail Message-ID cache."
+ :group 'nnmail-duplicate
+ :group 'nnmail-files
+ :type 'file)
+
+(defcustom nnmail-treat-duplicates 'warn
+ "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
+Three values are legal: nil, which means that nnmail is not to keep a
+Message-ID cache; `warn', which means that nnmail should insert extra
+headers to warn the user about the duplication (this is the default);
+and `delete', which means that nnmail will delete duplicated mails.
+
+This variable can also be a function. It will be called from a buffer
+narrowed to the article in question with the Message-ID as a
+parameter. It should return nil, `warn' or `delete'."
+ :group 'nnmail-duplicate
+ :type '(choice (const :tag "off" nil)
+ (const warn)
+ (const delete)))
+
+;;; Internal variables.
+
+(defvar nnmail-split-history nil
+ "List of group/article elements that say where the previous split put messages.")
+
+(defvar nnmail-pop-password nil
+ "*Password to use when reading mail from a POP server, if required.")
+
+(defvar nnmail-split-fancy-syntax-table nil
+ "Syntax table used by `nnmail-split-fancy'.")
+(unless (syntax-table-p nnmail-split-fancy-syntax-table)
+ (setq nnmail-split-fancy-syntax-table
+ (copy-syntax-table (standard-syntax-table)))
+ ;; support the %-hack
+ (modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table))
+
+(defvar nnmail-prepare-save-mail-hook nil
+ "Hook called before saving mail.")
+
+(defvar nnmail-moved-inboxes nil
+ "List of inboxes that have been moved.")
+
+(defvar nnmail-internal-password nil)
+
+\f
+
+(defconst nnmail-version "nnmail 1.0"
+ "nnmail version.")
+
+\f
+
+(defun nnmail-request-post (&optional server)
+ (mail-send-and-exit nil))
+
+;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+(defvar nnmail-file-coding-system nil
+ "Coding system used in nnmail.")
+
+(defun nnmail-find-file (file)
+ "Insert FILE in server buffer safely."
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let ((format-alist nil)
+ (after-insert-file-functions nil))
+ (condition-case ()
+ ;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ (let ((coding-system-for-read nnmail-file-coding-system)
+ ;; 1997/8/12 by MORIOKA Tomohiko
+ ;; for XEmacs/mule.
+ (pathname-coding-system 'binary))
+ (insert-file-contents file)
+ t)
+ (file-error nil))))
+
+;; 1997/8/10 by MORIOKA Tomohiko
+(defvar nnmail-pathname-coding-system
+ 'iso-8859-1
+ "*Coding system for pathname.")
+
+(defun nnmail-group-pathname (group dir &optional file)
+ "Make pathname for GROUP."
+ (concat
+ (let ((dir (file-name-as-directory (expand-file-name dir))))
+ ;; If this directory exists, we use it directly.
+ (if (or nnmail-use-long-file-names
+ (file-directory-p (concat dir group)))
+ (concat dir group "/")
+ ;; If not, we translate dots into slashes.
+ (concat dir
+ (gnus-encode-coding-string
+ (nnheader-replace-chars-in-string group ?. ?/)
+ nnmail-pathname-coding-system)
+ "/")))
+ (or file "")))
+
+(defun nnmail-date-to-time (date)
+ "Convert DATE into time."
+ (condition-case ()
+ (let* ((d1 (timezone-parse-date date))
+ (t1 (timezone-parse-time (aref d1 3))))
+ (apply 'encode-time
+ (mapcar (lambda (el)
+ (and el (string-to-number el)))
+ (list
+ (aref t1 2) (aref t1 1) (aref t1 0)
+ (aref d1 2) (aref d1 1) (aref d1 0)
+ (number-to-string
+ (* 60 (timezone-zone-to-minute (aref d1 4))))))))
+ ;; If we get an error, then we just return a 0 time.
+ (error (list 0 0))))
+
+(defun nnmail-time-less (t1 t2)
+ "Say whether time T1 is less than time T2."
+ (or (< (car t1) (car t2))
+ (and (= (car t1) (car t2))
+ (< (nth 1 t1) (nth 1 t2)))))
+
+(defun nnmail-days-to-time (days)
+ "Convert DAYS into time."
+ (let* ((seconds (* 1.0 days 60 60 24))
+ (rest (expt 2 16))
+ (ms (condition-case nil (round (/ seconds rest))
+ (range-error (expt 2 16)))))
+ (list ms (condition-case nil (round (- seconds (* ms rest)))
+ (range-error (expt 2 16))))))
+
+(defun nnmail-time-since (time)
+ "Return the time since TIME, which is either an internal time or a date."
+ (when (stringp time)
+ ;; Convert date strings to internal time.
+ (setq time (nnmail-date-to-time time)))
+ (let* ((current (current-time))
+ (rest (when (< (nth 1 current) (nth 1 time))
+ (expt 2 16))))
+ (list (- (+ (car current) (if rest -1 0)) (car time))
+ (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
+
+;; Function rewritten from rmail.el.
+(defun nnmail-move-inbox (inbox)
+ "Move INBOX to `nnmail-crash-box'."
+ (if (not (file-writable-p nnmail-crash-box))
+ (gnus-error 1 "Can't write to crash box %s. Not moving mail"
+ nnmail-crash-box)
+ ;; If the crash box exists and is empty, we delete it.
+ (when (and (file-exists-p nnmail-crash-box)
+ (zerop (nnheader-file-size (file-truename nnmail-crash-box))))
+ (delete-file nnmail-crash-box))
+ (let ((tofile (file-truename (expand-file-name nnmail-crash-box)))
+ (popmail (string-match "^po:" inbox))
+ movemail errors result)
+ (unless popmail
+ (setq inbox (file-truename (expand-file-name inbox)))
+ (setq movemail t)
+ ;; On some systems, /usr/spool/mail/foo is a directory
+ ;; and the actual inbox is /usr/spool/mail/foo/foo.
+ (when (file-directory-p inbox)
+ (setq inbox (expand-file-name (user-login-name) inbox))))
+ (if (member inbox nnmail-moved-inboxes)
+ ;; We don't try to move an already moved inbox.
+ nil
+ (if popmail
+ (progn
+ (when (and nnmail-pop-password
+ (not nnmail-internal-password))
+ (setq nnmail-internal-password nnmail-pop-password))
+ (when (and nnmail-pop-password-required
+ (not nnmail-internal-password))
+ (setq nnmail-internal-password
+ (nnmail-read-passwd
+ (format "Password for %s: "
+ (substring inbox (+ popmail 3))))))
+ (message "Getting mail from the post office..."))
+ (when (or (and (file-exists-p tofile)
+ (/= 0 (nnheader-file-size tofile)))
+ (and (file-exists-p inbox)
+ (/= 0 (nnheader-file-size inbox))))
+ (message "Getting mail from %s..." inbox)))
+ ;; Set TOFILE if have not already done so, and
+ ;; rename or copy the file INBOX to TOFILE if and as appropriate.
+ (cond
+ ((file-exists-p tofile)
+ ;; The crash box exists already.
+ t)
+ ((and (not popmail)
+ (not (file-exists-p inbox)))
+ ;; There is no inbox.
+ (setq tofile nil))
+ (t
+ ;; If getting from mail spool directory, use movemail to move
+ ;; rather than just renaming, so as to interlock with the
+ ;; mailer.
+ (unwind-protect
+ (save-excursion
+ (setq errors (generate-new-buffer " *nnmail loss*"))
+ (buffer-disable-undo errors)
+ (let ((default-directory "/"))
+ (if (nnheader-functionp nnmail-movemail-program)
+ (condition-case err
+ (progn
+ (funcall nnmail-movemail-program inbox tofile)
+ (setq result 0))
+ (error
+ (save-excursion
+ (set-buffer errors)
+ (insert (prin1-to-string err))
+ (setq result 255))))
+ (setq result
+ (apply
+ 'call-process
+ (append
+ (list
+ (expand-file-name
+ nnmail-movemail-program exec-directory)
+ nil errors nil inbox tofile)
+ (when nnmail-internal-password
+ (list nnmail-internal-password)))))))
+ (if (and (not (buffer-modified-p errors))
+ (zerop result))
+ ;; No output => movemail won
+ (progn
+ (unless popmail
+ (when (file-exists-p tofile)
+ (set-file-modes tofile nnmail-default-file-modes)))
+ (push inbox nnmail-moved-inboxes))
+ (set-buffer errors)
+ ;; There may be a warning about older revisions. We
+ ;; ignore those.
+ (goto-char (point-min))
+ (if (search-forward "older revision" nil t)
+ (progn
+ (unless popmail
+ (when (file-exists-p tofile)
+ (set-file-modes tofile nnmail-default-file-modes)))
+ (push inbox nnmail-moved-inboxes))
+ ;; Probably a real error.
+ (subst-char-in-region (point-min) (point-max) ?\n ?\ )
+ (goto-char (point-max))
+ (skip-chars-backward " \t")
+ (delete-region (point) (point-max))
+ (goto-char (point-min))
+ (when (looking-at "movemail: ")
+ (delete-region (point-min) (match-end 0)))
+ (unless (yes-or-no-p
+ (format "movemail: %s (%d return). Continue? "
+ (buffer-string) result))
+ (error "%s" (buffer-string)))
+ (setq tofile nil)))))))
+ (message "Getting mail from %s...done" inbox)
+ (and errors
+ (buffer-name errors)
+ (kill-buffer errors))
+ tofile))))
+
+(defun nnmail-get-active ()
+ "Returns an assoc of group names and active ranges.
+nn*-request-list should have been called before calling this function."
+ (let (group-assoc)
+ ;; Go through all groups from the active list.
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
+ ;; We create an alist with `(GROUP (LOW . HIGH))' elements.
+ (push (list (match-string 1)
+ (cons (string-to-int (match-string 3))
+ (string-to-int (match-string 2))))
+ group-assoc)))
+ group-assoc))
+
+;; 1997/8/12 by MORIOKA Tomohiko
+(defvar nnmail-active-file-coding-system
+ 'iso-8859-1
+ "*Coding system for active file.")
+
+(defun nnmail-save-active (group-assoc file-name)
+ "Save GROUP-ASSOC in ACTIVE-FILE."
+ (let ((coding-system-for-write nnmail-active-file-coding-system))
+ (when file-name
+ (nnheader-temp-write file-name
+ (nnmail-generate-active group-assoc)))))
+
+(defun nnmail-generate-active (alist)
+ "Generate an active file from group-alist ALIST."
+ (erase-buffer)
+ (let (group)
+ (while (setq group (pop alist))
+ (insert (format "%s %d %d y\n" (car group) (cdadr group)
+ (caadr group))))))
+
+(defun nnmail-get-split-group (file group)
+ "Find out whether this FILE is to be split into GROUP only.
+If GROUP is non-nil and we are using procmail, return the group name
+only when the file is the correct procmail file. When GROUP is nil,
+return nil if FILE is a spool file or the procmail group for which it
+is a spool. If not using procmail, return GROUP."
+ (if (or (eq nnmail-spool-file 'procmail)
+ nnmail-use-procmail)
+ (if (string-match (concat "^" (expand-file-name
+ (file-name-as-directory
+ nnmail-procmail-directory))
+ "\\([^/]*\\)" nnmail-procmail-suffix "$")
+ (expand-file-name file))
+ (let ((procmail-group (substring (expand-file-name file)
+ (match-beginning 1)
+ (match-end 1))))
+ (if group
+ (if (string-equal group procmail-group)
+ group
+ nil)
+ procmail-group))
+ nil)
+ group))
+
+(defun nnmail-process-babyl-mail-format (func artnum-func)
+ (let ((case-fold-search t)
+ start message-id content-length do-search end)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (re-search-forward
+ "\f\n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
+ (goto-char (match-end 0))
+ (delete-region (match-beginning 0) (match-end 0))
+ (narrow-to-region
+ (setq start (point))
+ (progn
+ ;; Skip all the headers in case there are more "From "s...
+ (or (search-forward "\n\n" nil t)
+ (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
+ (search-forward "\1f\f"))
+ (point)))
+ ;; Unquote the ">From " line, if any.
+ (goto-char (point-min))
+ (when (looking-at ">From ")
+ (replace-match "X-From-Line: ") )
+ (run-hooks 'nnmail-prepare-incoming-header-hook)
+ (goto-char (point-max))
+ ;; Find the Message-ID header.
+ (save-excursion
+ (if (re-search-backward
+ "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
+ (setq message-id (buffer-substring (match-beginning 1)
+ (match-end 1)))
+ ;; There is no Message-ID here, so we create one.
+ (save-excursion
+ (when (re-search-backward "^Message-ID[ \t]*:" nil t)
+ (beginning-of-line)
+ (insert "Original-")))
+ (forward-line -1)
+ (insert "Message-ID: " (setq message-id (nnmail-message-id))
+ "\n")))
+ ;; Look for a Content-Length header.
+ (if (not (save-excursion
+ (and (re-search-backward
+ "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
+ (setq content-length (string-to-int
+ (buffer-substring
+ (match-beginning 1)
+ (match-end 1))))
+ ;; We destroy the header, since none of
+ ;; the backends ever use it, and we do not
+ ;; want to confuse other mailers by having
+ ;; a (possibly) faulty header.
+ (progn (insert "X-") t))))
+ (setq do-search t)
+ (widen)
+ (if (or (= (+ (point) content-length) (point-max))
+ (save-excursion
+ (goto-char (+ (point) content-length))
+ (looking-at "\1f")))
+ (progn
+ (goto-char (+ (point) content-length))
+ (setq do-search nil))
+ (setq do-search t)))
+ (widen)
+ ;; Go to the beginning of the next article - or to the end
+ ;; of the buffer.
+ (when do-search
+ (if (re-search-forward "^\1f" nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (1- (point-max)))))
+ (delete-char 1) ; delete ^_
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point))
+ (goto-char (point-min))
+ (nnmail-check-duplication message-id func artnum-func)
+ (setq end (point-max))))
+ (goto-char end))))
+
+(defsubst nnmail-search-unix-mail-delim ()
+ "Put point at the beginning of the next Unix mbox message."
+ ;; Algorithm used to find the the next article in the
+ ;; brain-dead Unix mbox format:
+ ;;
+ ;; 1) Search for "^From ".
+ ;; 2) If we find it, then see whether the previous
+ ;; line is blank and the next line looks like a header.
+ ;; Then it's possible that this is a mail delim, and we use it.
+ (let ((case-fold-search nil)
+ found)
+ (while (not found)
+ (if (not (re-search-forward "^From " nil t))
+ (setq found 'no)
+ (save-excursion
+ (beginning-of-line)
+ (when (and (or (bobp)
+ (save-excursion
+ (forward-line -1)
+ (= (following-char) ?\n)))
+ (save-excursion
+ (forward-line 1)
+ (while (looking-at ">From \\|From ")
+ (forward-line 1))
+ (looking-at "[^ \n\t:]+[ \n\t]*:")))
+ (setq found 'yes)))))
+ (beginning-of-line)
+ (eq found 'yes)))
+
+(defun nnmail-search-unix-mail-delim-backward ()
+ "Put point at the beginning of the current Unix mbox message."
+ ;; Algorithm used to find the the next article in the
+ ;; brain-dead Unix mbox format:
+ ;;
+ ;; 1) Search for "^From ".
+ ;; 2) If we find it, then see whether the previous
+ ;; line is blank and the next line looks like a header.
+ ;; Then it's possible that this is a mail delim, and we use it.
+ (let ((case-fold-search nil)
+ found)
+ (while (not found)
+ (if (not (re-search-backward "^From " nil t))
+ (setq found 'no)
+ (save-excursion
+ (beginning-of-line)
+ (when (and (or (bobp)
+ (save-excursion
+ (forward-line -1)
+ (= (following-char) ?\n)))
+ (save-excursion
+ (forward-line 1)
+ (while (looking-at ">From \\|From ")
+ (forward-line 1))
+ (looking-at "[^ \n\t:]+[ \n\t]*:")))
+ (setq found 'yes)))))
+ (beginning-of-line)
+ (eq found 'yes)))
+
+(defun nnmail-process-unix-mail-format (func artnum-func)
+ (let ((case-fold-search t)
+ start message-id content-length end skip head-end)
+ (goto-char (point-min))
+ (if (not (and (re-search-forward "^From " nil t)
+ (goto-char (match-beginning 0))))
+ ;; Possibly wrong format?
+ (error "Error, unknown mail format! (Possibly corrupted.)")
+ ;; Carry on until the bitter end.
+ (while (not (eobp))
+ (setq start (point)
+ end nil)
+ ;; Find the end of the head.
+ (narrow-to-region
+ start
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ ;; This will never happen, but just to be on the safe side --
+ ;; if there is no head-body delimiter, we search a bit manually.
+ (while (and (looking-at "From \\|[^ \t]+:")
+ (not (eobp)))
+ (forward-line 1))
+ (point)))
+ ;; Find the Message-ID header.
+ (goto-char (point-min))
+ (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
+ (setq message-id (match-string 1))
+ (save-excursion
+ (when (re-search-forward "^Message-ID[ \t]*:" nil t)
+ (beginning-of-line)
+ (insert "Original-")))
+ ;; There is no Message-ID here, so we create one.
+ (forward-line 1)
+ (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
+ ;; Look for a Content-Length header.
+ (goto-char (point-min))
+ (if (not (re-search-forward
+ "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
+ (setq content-length nil)
+ (setq content-length (string-to-int (match-string 1)))
+ ;; We destroy the header, since none of the backends ever
+ ;; use it, and we do not want to confuse other mailers by
+ ;; having a (possibly) faulty header.
+ (beginning-of-line)
+ (insert "X-"))
+ (run-hooks 'nnmail-prepare-incoming-header-hook)
+ ;; Find the end of this article.
+ (goto-char (point-max))
+ (widen)
+ (setq head-end (point))
+ ;; We try the Content-Length value. The idea: skip over the header
+ ;; separator, then check what happens content-length bytes into the
+ ;; message body. This should be either the end ot the buffer, the
+ ;; message separator or a blank line followed by the separator.
+ ;; The blank line should probably be deleted. If neither of the
+ ;; three is met, the content-length header is probably invalid.
+ (when content-length
+ (forward-line 1)
+ (setq skip (+ (point) content-length))
+ (goto-char skip)
+ (cond ((or (= skip (point-max))
+ (= (1+ skip) (point-max)))
+ (setq end (point-max)))
+ ((looking-at "From ")
+ (setq end skip))
+ ((looking-at "[ \t]*\n\\(From \\)")
+ (setq end (match-beginning 1)))
+ (t (setq end nil))))
+ (if end
+ (goto-char end)
+ ;; No Content-Length, so we find the beginning of the next
+ ;; article or the end of the buffer.
+ (goto-char head-end)
+ (or (nnmail-search-unix-mail-delim)
+ (goto-char (point-max))))
+ ;; Allow the backend to save the article.
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point))
+ (goto-char (point-min))
+ (nnmail-check-duplication message-id func artnum-func)
+ (setq end (point-max))))
+ (goto-char end)))))
+
+(defun nnmail-process-mmdf-mail-format (func artnum-func)
+ (let ((delim "^\^A\^A\^A\^A$")
+ (case-fold-search t)
+ start message-id end)
+ (goto-char (point-min))
+ (if (not (and (re-search-forward delim nil t)
+ (forward-line 1)))
+ ;; Possibly wrong format?
+ (error "Error, unknown mail format! (Possibly corrupted.)")
+ ;; Carry on until the bitter end.
+ (while (not (eobp))
+ (setq start (point))
+ ;; Find the end of the head.
+ (narrow-to-region
+ start
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ ;; This will never happen, but just to be on the safe side --
+ ;; if there is no head-body delimiter, we search a bit manually.
+ (while (and (looking-at "From \\|[^ \t]+:")
+ (not (eobp)))
+ (forward-line 1))
+ (point)))
+ ;; Find the Message-ID header.
+ (goto-char (point-min))
+ (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
+ (setq message-id (match-string 1))
+ ;; There is no Message-ID here, so we create one.
+ (save-excursion
+ (when (re-search-backward "^Message-ID[ \t]*:" nil t)
+ (beginning-of-line)
+ (insert "Original-")))
+ (forward-line 1)
+ (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
+ (run-hooks 'nnmail-prepare-incoming-header-hook)
+ ;; Find the end of this article.
+ (goto-char (point-max))
+ (widen)
+ (if (re-search-forward delim nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))
+ ;; Allow the backend to save the article.
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point))
+ (goto-char (point-min))
+ (nnmail-check-duplication message-id func artnum-func)
+ (setq end (point-max))))
+ (goto-char end)
+ (forward-line 2)))))
+
+(defun nnmail-split-incoming (incoming func &optional exit-func
+ group artnum-func)
+ "Go through the entire INCOMING file and pick out each individual mail.
+FUNC will be called with the buffer narrowed to each mail."
+ (let (;; If this is a group-specific split, we bind the split
+ ;; methods to just this group.
+ (nnmail-split-methods (if (and group
+ (or (eq nnmail-spool-file 'procmail)
+ nnmail-use-procmail)
+ (not nnmail-resplit-incoming))
+ (list (list group ""))
+ nnmail-split-methods)))
+ (save-excursion
+ ;; Insert the incoming file.
+ (set-buffer (get-buffer-create " *nnmail incoming*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (nnheader-insert-file-contents incoming)
+ (unless (zerop (buffer-size))
+ (goto-char (point-min))
+ (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
+ ;; Handle both babyl, MMDF and unix mail formats, since movemail will
+ ;; use the former when fetching from a mailbox, the latter when
+ ;; fetching from a file.
+ (cond ((or (looking-at "\^L")
+ (looking-at "BABYL OPTIONS:"))
+ (nnmail-process-babyl-mail-format func artnum-func))
+ ((looking-at "\^A\^A\^A\^A")
+ (nnmail-process-mmdf-mail-format func artnum-func))
+ (t
+ (nnmail-process-unix-mail-format func artnum-func))))
+ (when exit-func
+ (funcall exit-func))
+ (kill-buffer (current-buffer)))))
+
+;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
+(defun nnmail-article-group (func)
+ "Look at the headers and return an alist of groups that match.
+FUNC will be called with the group name to determine the article number."
+ (let ((methods nnmail-split-methods)
+ (obuf (current-buffer))
+ (beg (point-min))
+ end group-art method)
+ (if (and (sequencep methods) (= (length methods) 1))
+ ;; If there is only just one group to put everything in, we
+ ;; just return a list with just this one method in.
+ (setq group-art
+ (list (cons (caar methods) (funcall func (caar methods)))))
+ ;; We do actual comparison.
+ (save-excursion
+ ;; Find headers.
+ (goto-char beg)
+ (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ ;; Copy the headers into the work buffer.
+ (insert-buffer-substring obuf beg end)
+ ;; Fold continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ ;; Allow washing.
+ (run-hooks 'nnmail-split-hook)
+ (if (and (symbolp nnmail-split-methods)
+ (fboundp nnmail-split-methods))
+ (let ((split
+ (condition-case nil
+ ;; `nnmail-split-methods' is a function, so we
+ ;; just call this function here and use the
+ ;; result.
+ (or (funcall nnmail-split-methods)
+ '("bogus"))
+ (error
+ (message
+ "Error in `nnmail-split-methods'; using `bogus' mail group")
+ (sit-for 1)
+ '("bogus")))))
+ ;; The article may be "cross-posted" to `junk'. What
+ ;; to do? Just remove the `junk' spec. Don't really
+ ;; see anything else to do...
+ (let (elem)
+ (while (setq elem (car (memq 'junk split)))
+ (setq split (delq elem split))))
+ (when split
+ (setq group-art
+ (mapcar
+ (lambda (group) (cons group (funcall func group)))
+ split))))
+ ;; Go through the split methods to find a match.
+ (while (and methods (or nnmail-crosspost (not group-art)))
+ (goto-char (point-max))
+ (setq method (pop methods))
+ (if (or methods
+ (not (equal "" (nth 1 method))))
+ (when (and
+ (ignore-errors
+ (if (stringp (nth 1 method))
+ (re-search-backward (cadr method) nil t)
+ ;; Function to say whether this is a match.
+ (funcall (nth 1 method) (car method))))
+ ;; Don't enter the article into the same
+ ;; group twice.
+ (not (assoc (car method) group-art)))
+ (push (cons (car method) (funcall func (car method)))
+ group-art))
+ ;; This is the final group, which is used as a
+ ;; catch-all.
+ (unless group-art
+ (setq group-art
+ (list (cons (car method)
+ (funcall func (car method)))))))))
+ ;; See whether the split methods returned `junk'.
+ (if (equal group-art '(junk))
+ nil
+ ;; The article may be "cross-posted" to `junk'. What
+ ;; to do? Just remove the `junk' spec. Don't really
+ ;; see anything else to do...
+ (let (elem)
+ (while (setq elem (car (memq 'junk group-art)))
+ (setq group-art (delq elem group-art)))
+ (nreverse group-art)))))))
+
+(defun nnmail-insert-lines ()
+ "Insert how many lines there are in the body of the mail.
+Return the number of characters in the body."
+ (let (lines chars)
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (setq chars (- (point-max) (point)))
+ (setq lines (count-lines (point) (point-max)))
+ (forward-char -1)
+ (save-excursion
+ (when (re-search-backward "^Lines: " nil t)
+ (delete-region (point) (progn (forward-line 1) (point)))))
+ (beginning-of-line)
+ (insert (format "Lines: %d\n" (max lines 0)))
+ chars))))
+
+(defun nnmail-insert-xref (group-alist)
+ "Insert an Xref line based on the (group . article) alist."
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (when (re-search-backward "^Xref: " nil t)
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point))))
+ (insert (format "Xref: %s" (system-name)))
+ (while group-alist
+ (insert (format " %s:%d"
+ (gnus-encode-coding-string (caar group-alist)
+ nnmail-pathname-coding-system)
+ (cdar group-alist)))
+ (setq group-alist (cdr group-alist)))
+ (insert "\n"))))
+
+;;; Message washing functions
+
+(defun nnmail-remove-leading-whitespace ()
+ "Remove excessive whitespace from all headers."
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([^ :]+: \\) +" nil t)
+ (replace-match "\\1" t)))
+
+(defun nnmail-remove-list-identifiers ()
+ "Remove list identifiers from Subject headers."
+ (let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers
+ (mapconcat 'identity nnmail-list-identifiers "\\|"))))
+ (when regexp
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^Subject: +\\(Re: +\\)?\\(" regexp "\\) *")
+ nil t)
+ (delete-region (match-beginning 2) (match-end 0))))))
+
+(defun nnmail-remove-tabs ()
+ "Translate TAB characters into SPACE characters."
+ (subst-char-in-region (point-min) (point-max) ?\t ? t))
+
+;;; Utility functions
+
+;; Written by byer@mv.us.adobe.com (Scott Byer).
+(defun nnmail-make-complex-temp-name (prefix)
+ (let ((newname (make-temp-name prefix))
+ (newprefix prefix))
+ (while (file-exists-p newname)
+ (setq newprefix (concat newprefix "x"))
+ (setq newname (make-temp-name newprefix)))
+ newname))
+
+;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
+
+(defun nnmail-split-fancy ()
+ "Fancy splitting method.
+See the documentation for the variable `nnmail-split-fancy' for documentation."
+ (let ((syntab (syntax-table)))
+ (unwind-protect
+ (progn
+ (set-syntax-table nnmail-split-fancy-syntax-table)
+ (nnmail-split-it nnmail-split-fancy))
+ (set-syntax-table syntab))))
+
+(defvar nnmail-split-cache nil)
+;; Alist of split expressions their equivalent regexps.
+
+(defun nnmail-split-it (split)
+ ;; Return a list of groups matching SPLIT.
+ (cond
+ ;; nil split
+ ((null split)
+ nil)
+
+ ;; A group name. Do the \& and \N subs into the string.
+ ((stringp split)
+ (list (nnmail-expand-newtext split)))
+
+ ;; Junk the message.
+ ((eq split 'junk)
+ (list 'junk))
+
+ ;; Builtin & operation.
+ ((eq (car split) '&)
+ (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
+
+ ;; Builtin | operation.
+ ((eq (car split) '|)
+ (let (done)
+ (while (and (not done) (cdr split))
+ (setq split (cdr split)
+ done (nnmail-split-it (car split))))
+ done))
+
+ ;; Builtin : operation.
+ ((eq (car split) ':)
+ (nnmail-split-it (eval (cdr split))))
+
+ ;; Check the cache for the regexp for this split.
+ ;; FIX FIX FIX could avoid calling assq twice here
+ ((assq split nnmail-split-cache)
+ (goto-char (point-max))
+ ;; FIX FIX FIX problem with re-search-backward is that if you have
+ ;; a split: (from "foo-\\(bar\\|baz\\)@gnus.org "mail.foo.\\1")
+ ;; and someone mails a message with 'To: foo-bar@gnus.org' and
+ ;; 'CC: foo-baz@gnus.org', we'll pick 'mail.foo.baz' as the group
+ ;; if the cc line is a later header, even though the other choice
+ ;; is probably better. Also, this routine won't do a crosspost
+ ;; when there are two different matches.
+ ;; I guess you could just make this more determined, and it could
+ ;; look for still more matches prior to this one, and recurse
+ ;; on each of the multiple matches hit. Of course, then you'd
+ ;; want to make sure that nnmail-article-group or nnmail-split-fancy
+ ;; removed duplicates, since there might be more of those.
+ ;; I guess we could also remove duplicates in the & split case, since
+ ;; that's the only thing that can introduce them.
+ (when (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
+ ;; Someone might want to do a \N sub on this match, so get the
+ ;; correct match positions.
+ (goto-char (match-end 0))
+ (let ((value (nth 1 split)))
+ (re-search-backward (if (symbolp value)
+ (cdr (assq value nnmail-split-abbrev-alist))
+ value)
+ (match-end 1)))
+ (nnmail-split-it (nth 2 split))))
+
+ ;; Not in cache, compute a regexp for the field/value pair.
+ (t
+ (let* ((field (nth 0 split))
+ (value (nth 1 split))
+ (regexp (concat "^\\(\\("
+ (if (symbolp field)
+ (cdr (assq field nnmail-split-abbrev-alist))
+ field)
+ "\\):.*\\)\\<\\("
+ (if (symbolp value)
+ (cdr (assq value nnmail-split-abbrev-alist))
+ value)
+ "\\)\\>")))
+ (push (cons split regexp) nnmail-split-cache)
+ ;; Now that it's in the cache, just call nnmail-split-it again
+ ;; on the same split, which will find it immediately in the cache.
+ (nnmail-split-it split)))))
+
+(defun nnmail-expand-newtext (newtext)
+ (let ((len (length newtext))
+ (pos 0)
+ c expanded beg N did-expand)
+ (while (< pos len)
+ (setq beg pos)
+ (while (and (< pos len)
+ (not (= (aref newtext pos) ?\\)))
+ (setq pos (1+ pos)))
+ (unless (= beg pos)
+ (push (substring newtext beg pos) expanded))
+ (when (< pos len)
+ ;; we hit a \, expand it.
+ (setq did-expand t)
+ (setq pos (1+ pos))
+ (setq c (aref newtext pos))
+ (if (not (or (= c ?\&)
+ (and (>= c ?1)
+ (<= c ?9))))
+ ;; \ followed by some character we don't expand
+ (push (char-to-string c) expanded)
+ ;; \& or \N
+ (if (= c ?\&)
+ (setq N 0)
+ (setq N (- c ?0)))
+ (when (match-beginning N)
+ (push (buffer-substring (match-beginning N) (match-end N))
+ expanded))))
+ (setq pos (1+ pos)))
+ (if did-expand
+ (apply 'concat (nreverse expanded))
+ newtext)))
+
+;; Get a list of spool files to read.
+(defun nnmail-get-spool-files (&optional group)
+ (if (null nnmail-spool-file)
+ ;; No spool file whatsoever.
+ nil
+ (let* ((procmails
+ ;; If procmail is used to get incoming mail, the files
+ ;; are stored in this directory.
+ (and (file-exists-p nnmail-procmail-directory)
+ (or (eq nnmail-spool-file 'procmail)
+ nnmail-use-procmail)
+ (directory-files
+ nnmail-procmail-directory
+ t (concat (if group (concat "^" group) "")
+ nnmail-procmail-suffix "$"))))
+ (p procmails)
+ (crash (when (and (file-exists-p nnmail-crash-box)
+ (> (nnheader-file-size
+ (file-truename nnmail-crash-box))
+ 0))
+ (list nnmail-crash-box))))
+ ;; Remove any directories that inadvertently match the procmail
+ ;; suffix, which might happen if the suffix is "".
+ (while p
+ (when (file-directory-p (car p))
+ (setq procmails (delete (car p) procmails)))
+ (setq p (cdr p)))
+ ;; Return the list of spools.
+ (append
+ crash
+ (cond ((and group
+ (or (eq nnmail-spool-file 'procmail)
+ nnmail-use-procmail)
+ procmails)
+ procmails)
+ ((and group
+ (eq nnmail-spool-file 'procmail))
+ nil)
+ ((listp nnmail-spool-file)
+ (nconc
+ (apply
+ 'nconc
+ (mapcar
+ (lambda (file)
+ (if (and (not (string-match "^po:" file))
+ (file-directory-p file))
+ (nnheader-directory-regular-files file)
+ (list file)))
+ nnmail-spool-file))
+ procmails))
+ ((stringp nnmail-spool-file)
+ (if (and (not (string-match "^po:" nnmail-spool-file))
+ (file-directory-p nnmail-spool-file))
+ (nconc
+ (nnheader-directory-regular-files nnmail-spool-file)
+ procmails)
+ (cons nnmail-spool-file procmails)))
+ ((eq nnmail-spool-file 'pop)
+ (cons (format "po:%s" (user-login-name)) procmails))
+ (t
+ procmails))))))
+
+;; Activate a backend only if it isn't already activated.
+;; If FORCE, re-read the active file even if the backend is
+;; already activated.
+(defun nnmail-activate (backend &optional force)
+ (nnheader-init-server-buffer)
+ (let (file timestamp file-time)
+ (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
+ force
+ (and (setq file (ignore-errors
+ (symbol-value (intern (format "%s-active-file"
+ backend)))))
+ (setq file-time (nth 5 (file-attributes file)))
+ (or (not
+ (setq timestamp
+ (condition-case ()
+ (symbol-value (intern
+ (format "%s-active-timestamp"
+ backend)))
+ (error 'none))))
+ (not (consp timestamp))
+ (equal timestamp '(0 0))
+ (> (nth 0 file-time) (nth 0 timestamp))
+ (and (= (nth 0 file-time) (nth 0 timestamp))
+ (> (nth 1 file-time) (nth 1 timestamp))))))
+ (save-excursion
+ (or (eq timestamp 'none)
+ (set (intern (format "%s-active-timestamp" backend))
+ file-time))
+ (funcall (intern (format "%s-request-list" backend)))))
+ t))
+
+(defun nnmail-message-id ()
+ (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
+
+;;;
+;;; nnmail duplicate handling
+;;;
+
+(defvar nnmail-cache-buffer nil)
+
+(defun nnmail-cache-open ()
+ (if (or (not nnmail-treat-duplicates)
+ (and nnmail-cache-buffer
+ (buffer-name nnmail-cache-buffer)))
+ () ; The buffer is open.
+ (save-excursion
+ (set-buffer
+ (setq nnmail-cache-buffer
+ (get-buffer-create " *nnmail message-id cache*")))
+ (buffer-disable-undo (current-buffer))
+ (when (file-exists-p nnmail-message-id-cache-file)
+ (nnheader-insert-file-contents nnmail-message-id-cache-file))
+ (set-buffer-modified-p nil)
+ (current-buffer))))
+
+(defun nnmail-cache-close ()
+ (when (and nnmail-cache-buffer
+ nnmail-treat-duplicates
+ (buffer-name nnmail-cache-buffer)
+ (buffer-modified-p nnmail-cache-buffer))
+ (save-excursion
+ (set-buffer nnmail-cache-buffer)
+ ;; Weed out the excess number of Message-IDs.
+ (goto-char (point-max))
+ (when (search-backward "\n" nil t nnmail-message-id-cache-length)
+ (progn
+ (beginning-of-line)
+ (delete-region (point-min) (point))))
+ ;; Save the buffer.
+ (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
+ (make-directory (file-name-directory nnmail-message-id-cache-file)
+ t))
+ (nnmail-write-region (point-min) (point-max)
+ nnmail-message-id-cache-file nil 'silent)
+ (set-buffer-modified-p nil)
+ (setq nnmail-cache-buffer nil)
+ (kill-buffer (current-buffer)))))
+
+(defun nnmail-cache-insert (id)
+ (when nnmail-treat-duplicates
+ (unless (gnus-buffer-live-p nnmail-cache-buffer)
+ (nnmail-cache-open))
+ (save-excursion
+ (set-buffer nnmail-cache-buffer)
+ (goto-char (point-max))
+ (insert id "\n"))))
+
+(defun nnmail-cache-id-exists-p (id)
+ (when nnmail-treat-duplicates
+ (save-excursion
+ (set-buffer nnmail-cache-buffer)
+ (goto-char (point-max))
+ (search-backward id nil t))))
+
+(defun nnmail-fetch-field (header)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-head)
+ (message-fetch-field header))))
+
+(defun nnmail-check-duplication (message-id func artnum-func)
+ (run-hooks 'nnmail-prepare-incoming-message-hook)
+ ;; If this is a duplicate message, then we do not save it.
+ (let* ((duplication (nnmail-cache-id-exists-p message-id))
+ (case-fold-search t)
+ (action (when duplication
+ (cond
+ ((memq nnmail-treat-duplicates '(warn delete))
+ nnmail-treat-duplicates)
+ ((nnheader-functionp nnmail-treat-duplicates)
+ (funcall nnmail-treat-duplicates message-id))
+ (t
+ nnmail-treat-duplicates))))
+ group-art)
+ ;; Let the backend save the article (or not).
+ (cond
+ ((not duplication)
+ (nnmail-cache-insert message-id)
+ (funcall func (setq group-art
+ (nreverse (nnmail-article-group artnum-func)))))
+ ((eq action 'delete)
+ (setq group-art nil))
+ ((eq action 'warn)
+ ;; We insert a warning.
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (re-search-forward "^message-id[ \t]*:" nil t)
+ (beginning-of-line)
+ (insert
+ "Gnus-Warning: This is a duplicate of message " message-id "\n")
+ (funcall func (setq group-art
+ (nreverse (nnmail-article-group artnum-func))))))
+ (t
+ (funcall func (setq group-art
+ (nreverse (nnmail-article-group artnum-func))))))
+ ;; Add the group-art list to the history list.
+ (if group-art
+ (push group-art nnmail-split-history)
+ (delete-region (point-min) (point-max)))))
+
+;;; Get new mail.
+
+(defun nnmail-get-value (&rest args)
+ (let ((sym (intern (apply 'format args))))
+ (when (boundp sym)
+ (symbol-value sym))))
+
+(defun nnmail-get-new-mail (method exit-func temp
+ &optional group spool-func)
+ "Read new incoming mail."
+ ;; Nix out the previous split history.
+ (unless group
+ (setq nnmail-split-history nil))
+ (let* ((spools (nnmail-get-spool-files group))
+ (group-in group)
+ incoming incomings spool)
+ (when (and (nnmail-get-value "%s-get-new-mail" method)
+ nnmail-spool-file)
+ ;; We first activate all the groups.
+ (nnmail-activate method)
+ ;; Allow the user to hook.
+ (run-hooks 'nnmail-pre-get-new-mail-hook)
+ ;; Open the message-id cache.
+ (nnmail-cache-open)
+ ;; The we go through all the existing spool files and split the
+ ;; mail from each.
+ (while spools
+ (setq spool (pop spools))
+ ;; We read each spool file if either the spool is a POP-mail
+ ;; spool, or the file exists. We can't check for the
+ ;; existence of POPped mail.
+ (when (or (string-match "^po:" spool)
+ (and (file-exists-p (file-truename spool))
+ (> (nnheader-file-size (file-truename spool)) 0)))
+ (nnheader-message 3 "%s: Reading incoming mail..." method)
+ (when (and (nnmail-move-inbox spool)
+ (file-exists-p nnmail-crash-box))
+ ;; There is new mail. We first find out if all this mail
+ ;; is supposed to go to some specific group.
+ (setq group (nnmail-get-split-group spool group-in))
+ ;; We split the mail
+ (nnmail-split-incoming
+ nnmail-crash-box (intern (format "%s-save-mail" method))
+ spool-func group (intern (format "%s-active-number" method)))
+ ;; Check whether the inbox is to be moved to the special tmp dir.
+ (setq incoming
+ (nnmail-make-complex-temp-name
+ (expand-file-name
+ (if nnmail-tmp-directory
+ (concat
+ (file-name-as-directory nnmail-tmp-directory)
+ (file-name-nondirectory
+ (concat (file-name-as-directory temp) "Incoming")))
+ (concat (file-name-as-directory temp) "Incoming")))))
+ (rename-file nnmail-crash-box incoming t)
+ (push incoming incomings))))
+ ;; If we did indeed read any incoming spools, we save all info.
+ (when incomings
+ (nnmail-save-active
+ (nnmail-get-value "%s-group-alist" method)
+ (nnmail-get-value "%s-active-file" method))
+ (when exit-func
+ (funcall exit-func))
+ (run-hooks 'nnmail-read-incoming-hook)
+ (nnheader-message 3 "%s: Reading incoming mail...done" method))
+ ;; Close the message-id cache.
+ (nnmail-cache-close)
+ ;; Allow the user to hook.
+ (run-hooks 'nnmail-post-get-new-mail-hook)
+ ;; Delete all the temporary files.
+ (while incomings
+ (setq incoming (pop incomings))
+ (and nnmail-delete-incoming
+ (file-exists-p incoming)
+ (file-writable-p incoming)
+ (delete-file incoming))))))
+
+(defun nnmail-expired-article-p (group time force &optional inhibit)
+ "Say whether an article that is TIME old in GROUP should be expired."
+ (if force
+ t
+ (let ((days (or (and nnmail-expiry-wait-function
+ (funcall nnmail-expiry-wait-function group))
+ nnmail-expiry-wait)))
+ (cond ((or (eq days 'never)
+ (and (not force)
+ inhibit))
+ ;; This isn't an expirable group.
+ nil)
+ ((eq days 'immediate)
+ ;; We expire all articles on sight.
+ t)
+ ((equal time '(0 0))
+ ;; This is an ange-ftp group, and we don't have any dates.
+ nil)
+ ((numberp days)
+ (setq days (nnmail-days-to-time days))
+ ;; Compare the time with the current time.
+ (nnmail-time-less days (nnmail-time-since time)))))))
+
+(defvar nnmail-read-passwd nil)
+(defun nnmail-read-passwd (prompt &rest args)
+ "Read a password using PROMPT.
+If ARGS, PROMPT is used as an argument to `format'."
+ (let ((prompt
+ (if args
+ (apply 'format prompt args)
+ prompt)))
+ (unless nnmail-read-passwd
+ (if (load "passwd" t)
+ (setq nnmail-read-passwd 'read-passwd)
+ (unless (fboundp 'ange-ftp-read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp"))
+ (setq nnmail-read-passwd 'ange-ftp-read-passwd)))
+ (funcall nnmail-read-passwd prompt)))
+
+(defun nnmail-check-syntax ()
+ "Check (and modify) the syntax of the message in the current buffer."
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((case-fold-search t))
+ (unless (re-search-forward "^Message-ID[ \t]*:" nil t)
+ (insert "Message-ID: " (nnmail-message-id) "\n")))))
+
+(defun nnmail-write-region (start end filename &optional append visit lockname)
+ "Do a `write-region', and then set the file modes."
+ ;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ (let ((coding-system-for-write nnmail-file-coding-system)
+ ;; 1997/8/12 by MORIOKA Tomohiko
+ ;; for XEmacs/mule.
+ (pathname-coding-system 'binary))
+ (write-region start end filename append visit lockname)
+ (set-file-modes filename nnmail-default-file-modes)))
+
+;;;
+;;; Status functions
+;;;
+
+(defun nnmail-replace-status (name value)
+ "Make status NAME and VALUE part of the current status line."
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((status (nnmail-decode-status)))
+ (setq status (delq (member name status) status))
+ (when value
+ (push (cons name value) status))
+ (message-remove-header "status")
+ (goto-char (point-max))
+ (insert "Status: " (nnmail-encode-status status) "\n"))))
+
+(defun nnmail-decode-status ()
+ "Return a status-value alist from STATUS."
+ (goto-char (point-min))
+ (when (re-search-forward "^Status: " nil t)
+ (let (name value status)
+ (save-restriction
+ ;; Narrow to the status.
+ (narrow-to-region
+ (point)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (1- (point))
+ (point-max)))
+ ;; Go through all elements and add them to the list.
+ (goto-char (point-min))
+ (while (re-search-forward "[^ \t=]+" nil t)
+ (setq name (match-string 0))
+ (if (not (= (following-char) ?=))
+ ;; Implied "yes".
+ (setq value "yes")
+ (forward-char 1)
+ (if (not (= (following-char) ?\"))
+ (if (not (looking-at "[^ \t]"))
+ ;; Implied "no".
+ (setq value "no")
+ ;; Unquoted value.
+ (setq value (match-string 0))
+ (goto-char (match-end 0)))
+ ;; Quoted value.
+ (setq value (read (current-buffer)))))
+ (push (cons name value) status)))
+ status)))
+
+(defun nnmail-encode-status (status)
+ "Return a status string from STATUS."
+ (mapconcat
+ (lambda (elem)
+ (concat
+ (car elem) "="
+ (if (string-match "[ \t]" (cdr elem))
+ (prin1-to-string (cdr elem))
+ (cdr elem))))
+ status " "))
+
+(defun nnmail-split-history ()
+ "Generate an overview of where the last mail split put articles."
+ (interactive)
+ (unless nnmail-split-history
+ (error "No current split history"))
+ (with-output-to-temp-buffer "*nnmail split history*"
+ (let ((history nnmail-split-history)
+ elem)
+ (while (setq elem (pop history))
+ (princ (mapconcat (lambda (ga)
+ (concat (car ga) ":" (int-to-string (cdr ga))))
+ elem
+ ", "))
+ (princ "\n")))))
+
+(defun nnmail-new-mail-p (group)
+ "Say whether GROUP has new mail."
+ (let ((his nnmail-split-history)
+ found)
+ (while his
+ (when (assoc group (pop his))
+ (setq found t
+ his nil)))
+ found))
+
+(eval-and-compile
+ (autoload 'pop3-movemail "pop3"))
+
+(defun nnmail-pop3-movemail (inbox crashbox)
+ "Function to move mail from INBOX on a pop3 server to file CRASHBOX."
+ (let ((pop3-maildrop
+ (substring inbox (match-end (string-match "^po:" inbox)))))
+ (pop3-movemail crashbox)))
+
+(run-hooks 'nnmail-load-hook)
+
+(provide 'nnmail)
+
+;;; nnmail.el ends here
--- /dev/null
+;;; nnmbox.el --- mail mbox access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.
+
+;;; Code:
+
+(require 'nnheader)
+(require 'message)
+(require 'nnmail)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nnmbox)
+
+(defvoo nnmbox-mbox-file (expand-file-name "~/mbox")
+ "The name of the mail box file in the user's home directory.")
+
+(defvoo nnmbox-active-file (expand-file-name "~/.mbox-active")
+ "The name of the active file for the mail box.")
+
+(defvoo nnmbox-get-new-mail t
+ "If non-nil, nnmbox will check the incoming mail file and split the mail.")
+
+(defvoo nnmbox-prepare-save-mail-hook nil
+ "Hook run narrowed to an article before saving.")
+
+\f
+
+(defconst nnmbox-version "nnmbox 1.0"
+ "nnmbox version.")
+
+(defvoo nnmbox-current-group nil
+ "Current nnmbox news group directory.")
+
+(defconst nnmbox-mbox-buffer nil)
+
+(defvoo nnmbox-status-string "")
+
+(defvoo nnmbox-group-alist nil)
+(defvoo nnmbox-active-timestamp nil)
+
+\f
+
+;;; Interface functions
+
+(nnoo-define-basics nnmbox)
+
+(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let ((number (length sequence))
+ (count 0)
+ article art-string start stop)
+ (nnmbox-possibly-change-newsgroup newsgroup server)
+ (while sequence
+ (setq article (car sequence))
+ (setq art-string (nnmbox-article-string article))
+ (set-buffer nnmbox-mbox-buffer)
+ (when (or (search-forward art-string nil t)
+ (progn (goto-char (point-min))
+ (search-forward art-string nil t)))
+ (setq start
+ (save-excursion
+ (re-search-backward
+ (concat "^" message-unix-mail-delimiter) nil t)
+ (point)))
+ (search-forward "\n\n" nil t)
+ (setq stop (1- (point)))
+ (set-buffer nntp-server-buffer)
+ (insert (format "221 %d Article retrieved.\n" article))
+ (insert-buffer-substring nnmbox-mbox-buffer start stop)
+ (goto-char (point-max))
+ (insert ".\n"))
+ (setq sequence (cdr sequence))
+ (setq count (1+ count))
+ (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)
+ (zerop (% count 20))
+ (nnheader-message 5 "nnmbox: Receiving headers... %d%%"
+ (/ (* count 100) number))))
+
+ (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)
+ (nnheader-message 5 "nnmbox: Receiving headers...done"))
+
+ (set-buffer nntp-server-buffer)
+ (nnheader-fold-continuation-lines)
+ 'headers)))
+
+(deffoo nnmbox-open-server (server &optional defs)
+ (nnoo-change-server 'nnmbox server defs)
+ (nnmbox-create-mbox)
+ (cond
+ ((not (file-exists-p nnmbox-mbox-file))
+ (nnmbox-close-server)
+ (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file))
+ ((file-directory-p nnmbox-mbox-file)
+ (nnmbox-close-server)
+ (nnheader-report 'nnmbox "Not a regular file: %s" nnmbox-mbox-file))
+ (t
+ (nnheader-report 'nnmbox "Opened server %s using mbox %s" server
+ nnmbox-mbox-file)
+ t)))
+
+(deffoo nnmbox-close-server (&optional server)
+ (when (and nnmbox-mbox-buffer
+ (buffer-name nnmbox-mbox-buffer))
+ (kill-buffer nnmbox-mbox-buffer))
+ (nnoo-close-server 'nnmbox server)
+ t)
+
+(deffoo nnmbox-server-opened (&optional server)
+ (and (nnoo-current-server-p 'nnmbox server)
+ nnmbox-mbox-buffer
+ (buffer-name nnmbox-mbox-buffer)
+ nntp-server-buffer
+ (buffer-name nntp-server-buffer)))
+
+(deffoo nnmbox-request-article (article &optional newsgroup server buffer)
+ (nnmbox-possibly-change-newsgroup newsgroup server)
+ (save-excursion
+ (set-buffer nnmbox-mbox-buffer)
+ (goto-char (point-min))
+ (when (search-forward (nnmbox-article-string article) nil t)
+ (let (start stop)
+ (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
+ (setq start (point))
+ (forward-line 1)
+ (or (and (re-search-forward
+ (concat "^" message-unix-mail-delimiter) nil t)
+ (forward-line -1))
+ (goto-char (point-max)))
+ (setq stop (point))
+ (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring nnmbox-mbox-buffer start stop)
+ (goto-char (point-min))
+ (while (looking-at "From ")
+ (delete-char 5)
+ (insert "X-From-Line: ")
+ (forward-line 1))
+ (if (numberp article)
+ (cons nnmbox-current-group article)
+ (nnmbox-article-group-number)))))))
+
+(deffoo nnmbox-request-group (group &optional server dont-check)
+ (let ((active (cadr (assoc group nnmbox-group-alist))))
+ (cond
+ ((or (null active)
+ (null (nnmbox-possibly-change-newsgroup group server)))
+ (nnheader-report 'nnmbox "No such group: %s" group))
+ (dont-check
+ (nnheader-report 'nnmbox "Selected group %s" group)
+ (nnheader-insert ""))
+ (t
+ (nnheader-report 'nnmbox "Selected group %s" group)
+ (nnheader-insert "211 %d %d %d %s\n"
+ (1+ (- (cdr active) (car active)))
+ (car active) (cdr active) group)))))
+
+(deffoo nnmbox-request-scan (&optional group server)
+ (nnmbox-possibly-change-newsgroup group server)
+ (nnmbox-read-mbox)
+ (nnmail-get-new-mail
+ 'nnmbox
+ (lambda ()
+ (save-excursion
+ (set-buffer nnmbox-mbox-buffer)
+ (save-buffer)))
+ (file-name-directory nnmbox-mbox-file)
+ group
+ (lambda ()
+ (save-excursion
+ (let ((in-buf (current-buffer)))
+ (set-buffer nnmbox-mbox-buffer)
+ (goto-char (point-max))
+ (insert-buffer-substring in-buf)))
+ (nnmail-save-active nnmbox-group-alist nnmbox-active-file))))
+
+(deffoo nnmbox-close-group (group &optional server)
+ t)
+
+(deffoo nnmbox-request-list (&optional server)
+ (save-excursion
+ (nnmail-find-file nnmbox-active-file)
+ (setq nnmbox-group-alist (nnmail-get-active))
+ t))
+
+(deffoo nnmbox-request-newgroups (date &optional server)
+ (nnmbox-request-list server))
+
+(deffoo nnmbox-request-list-newsgroups (&optional server)
+ (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented."))
+
+(deffoo nnmbox-request-expire-articles
+ (articles newsgroup &optional server force)
+ (nnmbox-possibly-change-newsgroup newsgroup server)
+ (let* ((is-old t)
+ rest)
+ (nnmail-activate 'nnmbox)
+
+ (save-excursion
+ (set-buffer nnmbox-mbox-buffer)
+ (while (and articles is-old)
+ (goto-char (point-min))
+ (when (search-forward (nnmbox-article-string (car articles)) nil t)
+ (if (setq is-old
+ (nnmail-expired-article-p
+ newsgroup
+ (buffer-substring
+ (point) (progn (end-of-line) (point))) force))
+ (progn
+ (nnheader-message 5 "Deleting article %d in %s..."
+ (car articles) newsgroup)
+ (nnmbox-delete-mail))
+ (push (car articles) rest)))
+ (setq articles (cdr articles)))
+ (save-buffer)
+ ;; Find the lowest active article in this group.
+ (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist))))
+ (goto-char (point-min))
+ (while (and (not (search-forward
+ (nnmbox-article-string (car active)) nil t))
+ (<= (car active) (cdr active)))
+ (setcar active (1+ (car active)))
+ (goto-char (point-min))))
+ (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
+ (nconc rest articles))))
+
+(deffoo nnmbox-request-move-article
+ (article group server accept-form &optional last)
+ (let ((buf (get-buffer-create " *nnmbox move*"))
+ result)
+ (and
+ (nnmbox-request-article article group server)
+ (save-excursion
+ (set-buffer buf)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-buffer-substring nntp-server-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^X-Gnus-Newsgroup:"
+ (save-excursion (search-forward "\n\n" nil t) (point)) t)
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ (setq result (eval accept-form))
+ (kill-buffer buf)
+ result)
+ (save-excursion
+ (nnmbox-possibly-change-newsgroup group server)
+ (set-buffer nnmbox-mbox-buffer)
+ (goto-char (point-min))
+ (when (search-forward (nnmbox-article-string article) nil t)
+ (nnmbox-delete-mail))
+ (and last (save-buffer))))
+ result))
+
+(deffoo nnmbox-request-accept-article (group &optional server last)
+ (nnmbox-possibly-change-newsgroup group server)
+ (nnmail-check-syntax)
+ (let ((buf (current-buffer))
+ result)
+ (goto-char (point-min))
+ ;; The From line may have been quoted by movemail.
+ (when (looking-at (concat ">" message-unix-mail-delimiter))
+ (delete-char 1))
+ (if (looking-at "X-From-Line: ")
+ (replace-match "From ")
+ (insert "From nobody " (current-time-string) "\n"))
+ (and
+ (nnmail-activate 'nnmbox)
+ (progn
+ (set-buffer buf)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (forward-line -1)
+ (while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (setq result (if (stringp group)
+ (list (cons group (nnmbox-active-number group)))
+ (nnmail-article-group 'nnmbox-active-number)))
+ (if (and (null result)
+ (yes-or-no-p "Moved to `junk' group; delete article? "))
+ (setq result 'junk)
+ (setq result (car (nnmbox-save-mail result)))))
+ (save-excursion
+ (set-buffer nnmbox-mbox-buffer)
+ (goto-char (point-max))
+ (insert-buffer-substring buf)
+ (when last
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-close))
+ (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
+ (save-buffer))))
+ result))
+
+(deffoo nnmbox-request-replace-article (article group buffer)
+ (nnmbox-possibly-change-newsgroup group)
+ (save-excursion
+ (set-buffer nnmbox-mbox-buffer)
+ (goto-char (point-min))
+ (if (not (search-forward (nnmbox-article-string article) nil t))
+ nil
+ (nnmbox-delete-mail t t)
+ (insert-buffer-substring buffer)
+ (save-buffer)
+ t)))
+
+(deffoo nnmbox-request-delete-group (group &optional force server)
+ (nnmbox-possibly-change-newsgroup group server)
+ ;; Delete all articles in GROUP.
+ (if (not force)
+ () ; Don't delete the articles.
+ (save-excursion
+ (set-buffer nnmbox-mbox-buffer)
+ (goto-char (point-min))
+ ;; Delete all articles in this group.
+ (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"))
+ found)
+ (while (search-forward ident nil t)
+ (setq found t)
+ (nnmbox-delete-mail))
+ (when found
+ (save-buffer)))))
+ ;; Remove the group from all structures.
+ (setq nnmbox-group-alist
+ (delq (assoc group nnmbox-group-alist) nnmbox-group-alist)
+ nnmbox-current-group nil)
+ ;; Save the active file.
+ (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
+ t)
+
+(deffoo nnmbox-request-rename-group (group new-name &optional server)
+ (nnmbox-possibly-change-newsgroup group server)
+ (save-excursion
+ (set-buffer nnmbox-mbox-buffer)
+ (goto-char (point-min))
+ (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"))
+ (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
+ found)
+ (while (search-forward ident nil t)
+ (replace-match new-ident t t)
+ (setq found t))
+ (when found
+ (save-buffer))))
+ (let ((entry (assoc group nnmbox-group-alist)))
+ (when entry
+ (setcar entry new-name))
+ (setq nnmbox-current-group nil)
+ ;; Save the new group alist.
+ (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
+ t))
+
+\f
+;;; Internal functions.
+
+;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
+;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
+;; delimiter line.
+(defun nnmbox-delete-mail (&optional force leave-delim)
+ ;; Delete the current X-Gnus-Newsgroup line.
+ (or force
+ (delete-region
+ (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ ;; Beginning of the article.
+ (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (save-excursion
+ (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
+ (if leave-delim (progn (forward-line 1) (point))
+ (match-beginning 0)))
+ (progn
+ (forward-line 1)
+ (or (and (re-search-forward (concat "^" message-unix-mail-delimiter)
+ nil t)
+ (if (and (not (bobp)) leave-delim)
+ (progn (forward-line -2) (point))
+ (match-beginning 0)))
+ (point-max))))
+ (goto-char (point-min))
+ ;; Only delete the article if no other groups owns it as well.
+ (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
+ (delete-region (point-min) (point-max))))))
+
+(defun nnmbox-possibly-change-newsgroup (newsgroup &optional server)
+ (when (and server
+ (not (nnmbox-server-opened server)))
+ (nnmbox-open-server server))
+ (when (or (not nnmbox-mbox-buffer)
+ (not (buffer-name nnmbox-mbox-buffer)))
+ (save-excursion
+ (set-buffer (setq nnmbox-mbox-buffer
+ (nnheader-find-file-noselect
+ nnmbox-mbox-file nil 'raw)))
+ (buffer-disable-undo (current-buffer))))
+ (when (not nnmbox-group-alist)
+ (nnmail-activate 'nnmbox))
+ (if newsgroup
+ (when (assoc newsgroup nnmbox-group-alist)
+ (setq nnmbox-current-group newsgroup))
+ t))
+
+(defun nnmbox-article-string (article)
+ (if (numberp article)
+ (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"
+ (int-to-string article) " ")
+ (concat "\nMessage-ID: " article)))
+
+(defun nnmbox-article-group-number ()
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
+ nil t)
+ (cons (buffer-substring (match-beginning 1) (match-end 1))
+ (string-to-int
+ (buffer-substring (match-beginning 2) (match-end 2)))))))
+
+(defun nnmbox-save-mail (group-art)
+ "Called narrowed to an article."
+ (let ((delim (concat "^" message-unix-mail-delimiter)))
+ (goto-char (point-min))
+ ;; This might come from somewhere else.
+ (unless (looking-at delim)
+ (insert "From nobody " (current-time-string) "\n")
+ (goto-char (point-min)))
+ ;; Quote all "From " lines in the article.
+ (forward-line 1)
+ (while (re-search-forward delim nil t)
+ (beginning-of-line)
+ (insert "> "))
+ (nnmail-insert-lines)
+ (nnmail-insert-xref group-art)
+ (nnmbox-insert-newsgroup-line group-art)
+ (run-hooks 'nnmail-prepare-save-mail-hook)
+ (run-hooks 'nnmbox-prepare-save-mail-hook)
+ group-art))
+
+(defun nnmbox-insert-newsgroup-line (group-art)
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (while group-art
+ (insert (format "X-Gnus-Newsgroup: %s:%d %s\n"
+ (caar group-art) (cdar group-art)
+ (current-time-string)))
+ (setq group-art (cdr group-art))))
+ t))
+
+(defun nnmbox-active-number (group)
+ ;; Find the next article number in GROUP.
+ (let ((active (cadr (assoc group nnmbox-group-alist))))
+ (if active
+ (setcdr active (1+ (cdr active)))
+ ;; This group is new, so we create a new entry for it.
+ ;; This might be a bit naughty... creating groups on the drop of
+ ;; a hat, but I don't know...
+ (push (list group (setq active (cons 1 1)))
+ nnmbox-group-alist))
+ (cdr active)))
+
+(defun nnmbox-create-mbox ()
+ (when (not (file-exists-p nnmbox-mbox-file))
+ (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg)))
+
+(defun nnmbox-read-mbox ()
+ (nnmail-activate 'nnmbox)
+ (nnmbox-create-mbox)
+ (if (and nnmbox-mbox-buffer
+ (buffer-name nnmbox-mbox-buffer)
+ (save-excursion
+ (set-buffer nnmbox-mbox-buffer)
+ (= (buffer-size) (nnheader-file-size nnmbox-mbox-file))))
+ ()
+ (save-excursion
+ (let ((delim (concat "^" message-unix-mail-delimiter))
+ (alist nnmbox-group-alist)
+ start end number)
+ (set-buffer (setq nnmbox-mbox-buffer
+ (nnheader-find-file-noselect
+ nnmbox-mbox-file nil 'raw)))
+ (buffer-disable-undo (current-buffer))
+
+ ;; Go through the group alist and compare against
+ ;; the mbox file.
+ (while alist
+ (goto-char (point-max))
+ (when (and (re-search-backward
+ (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
+ (caar alist)) nil t)
+ (>= (setq number
+ (string-to-number
+ (buffer-substring
+ (match-beginning 1) (match-end 1))))
+ (cdadar alist)))
+ (setcdr (cadar alist) (1+ number)))
+ (setq alist (cdr alist)))
+
+ (goto-char (point-min))
+ (while (re-search-forward delim nil t)
+ (setq start (match-beginning 0))
+ (when (not (search-forward "\nX-Gnus-Newsgroup: "
+ (save-excursion
+ (setq end
+ (or
+ (and
+ (re-search-forward delim nil t)
+ (match-beginning 0))
+ (point-max))))
+ t))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (nnmbox-save-mail
+ (nnmail-article-group 'nnmbox-active-number)))))
+ (goto-char end))))))
+
+(provide 'nnmbox)
+
+;;; nnmbox.el ends here
--- /dev/null
+;;; nnmh.el --- mhspool access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmail)
+(require 'gnus-start)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nnmh)
+
+(defvoo nnmh-directory message-directory
+ "*Mail spool directory.")
+
+(defvoo nnmh-get-new-mail t
+ "*If non-nil, nnmh will check the incoming mail file and split the mail.")
+
+(defvoo nnmh-prepare-save-mail-hook nil
+ "*Hook run narrowed to an article before saving.")
+
+(defvoo nnmh-be-safe nil
+ "*If non-nil, nnmh will check all articles to make sure whether they are new or not.")
+
+\f
+
+(defconst nnmh-version "nnmh 1.0"
+ "nnmh version.")
+
+(defvoo nnmh-current-directory nil
+ "Current news group directory.")
+
+(defvoo nnmh-status-string "")
+(defvoo nnmh-group-alist nil)
+(defvoo nnmh-allow-delete-final nil)
+
+\f
+
+;;; Interface functions.
+
+(nnoo-define-basics nnmh)
+
+(deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let* ((file nil)
+ (number (length articles))
+ (large (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)))
+ (count 0)
+ (pathname-coding-system 'binary)
+ beg article)
+ (nnmh-possibly-change-directory newsgroup server)
+ ;; We don't support fetching by Message-ID.
+ (if (stringp (car articles))
+ 'headers
+ (while articles
+ (when (and (file-exists-p
+ (setq file (concat (file-name-as-directory
+ nnmh-current-directory)
+ (int-to-string
+ (setq article (pop articles))))))
+ (not (file-directory-p file)))
+ (insert (format "221 %d Article retrieved.\n" article))
+ (setq beg (point))
+ (nnheader-insert-head file)
+ (goto-char beg)
+ (if (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (goto-char (point-max))
+ (insert "\n\n"))
+ (insert ".\n")
+ (delete-region (point) (point-max)))
+ (setq count (1+ count))
+
+ (and large
+ (zerop (% count 20))
+ (message "nnmh: Receiving headers... %d%%"
+ (/ (* count 100) number))))
+
+ (when large
+ (message "nnmh: Receiving headers...done"))
+
+ (nnheader-fold-continuation-lines)
+ 'headers))))
+
+(deffoo nnmh-open-server (server &optional defs)
+ (nnoo-change-server 'nnmh server defs)
+ (when (not (file-exists-p nnmh-directory))
+ (condition-case ()
+ (make-directory nnmh-directory t)
+ (error t)))
+ (cond
+ ((not (file-exists-p nnmh-directory))
+ (nnmh-close-server)
+ (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory))
+ ((not (file-directory-p (file-truename nnmh-directory)))
+ (nnmh-close-server)
+ (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory))
+ (t
+ (nnheader-report 'nnmh "Opened server %s using directory %s"
+ server nnmh-directory)
+ t)))
+
+(deffoo nnmh-request-article (id &optional newsgroup server buffer)
+ (nnmh-possibly-change-directory newsgroup server)
+ (let ((file (if (stringp id)
+ nil
+ (concat nnmh-current-directory (int-to-string id))))
+ (pathname-coding-system 'binary)
+ (nntp-server-buffer (or buffer nntp-server-buffer)))
+ (and (stringp file)
+ (file-exists-p file)
+ (not (file-directory-p file))
+ (save-excursion (nnmail-find-file file))
+ (string-to-int (file-name-nondirectory file)))))
+
+(deffoo nnmh-request-group (group &optional server dont-check)
+ (let ((pathname (nnmail-group-pathname group nnmh-directory))
+ (pathname-coding-system 'binary)
+ dir)
+ (cond
+ ((not (file-directory-p pathname))
+ (nnheader-report
+ 'nnmh "Can't select group (no such directory): %s" group))
+ (t
+ (setq nnmh-current-directory pathname)
+ (and nnmh-get-new-mail
+ nnmh-be-safe
+ (nnmh-update-gnus-unreads group))
+ (cond
+ (dont-check
+ (nnheader-report 'nnmh "Selected group %s" group)
+ t)
+ (t
+ ;; Re-scan the directory if it's on a foreign system.
+ (nnheader-re-read-dir pathname)
+ (setq dir
+ (sort
+ (mapcar (lambda (name) (string-to-int name))
+ (directory-files pathname nil "^[0-9]+$" t))
+ '<))
+ (cond
+ (dir
+ (nnheader-report 'nnmh "Selected group %s" group)
+ (nnheader-insert
+ "211 %d %d %d %s\n" (length dir) (car dir)
+ (progn (while (cdr dir) (setq dir (cdr dir))) (car dir))
+ group))
+ (t
+ (nnheader-report 'nnmh "Empty group %s" group)
+ (nnheader-insert (format "211 0 1 0 %s\n" group))))))))))
+
+(deffoo nnmh-request-scan (&optional group server)
+ (nnmail-get-new-mail 'nnmh nil nnmh-directory group))
+
+(deffoo nnmh-request-list (&optional server dir)
+ (nnheader-insert "")
+ (let ((pathname-coding-system 'binary)
+ (nnmh-toplev
+ (file-truename (or dir (file-name-as-directory nnmh-directory)))))
+ (nnmh-request-list-1 nnmh-toplev))
+ (setq nnmh-group-alist (nnmail-get-active))
+ t)
+
+(defvar nnmh-toplev)
+(defun nnmh-request-list-1 (dir)
+ (setq dir (expand-file-name dir))
+ ;; Recurse down all directories.
+ (let ((dirs (and (file-readable-p dir)
+ (> (nth 1 (file-attributes (file-chase-links dir))) 2)
+ (directory-files dir t nil t)))
+ rdir)
+ ;; Recurse down directories.
+ (while (setq rdir (pop dirs))
+ (when (and (not (member (file-name-nondirectory rdir) '("." "..")))
+ (file-directory-p rdir)
+ (file-readable-p rdir)
+ (equal (file-truename rdir)
+ (file-truename dir)))
+ (nnmh-request-list-1 rdir))))
+ ;; For each directory, generate an active file line.
+ (unless (string= (expand-file-name nnmh-toplev) dir)
+ (let ((files (mapcar
+ (lambda (name) (string-to-int name))
+ (directory-files dir nil "^[0-9]+$" t))))
+ (when files
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-max))
+ (insert
+ (format
+ "%s %d %d y\n"
+ (progn
+ (string-match
+ (regexp-quote
+ (file-truename (file-name-as-directory
+ (expand-file-name nnmh-toplev))))
+ dir)
+ (nnheader-replace-chars-in-string
+ (gnus-decode-coding-string (substring dir (match-end 0))
+ nnmail-pathname-coding-system)
+ ?/ ?.))
+ (apply 'max files)
+ (apply 'min files)))))))
+ t)
+
+(deffoo nnmh-request-newgroups (date &optional server)
+ (nnmh-request-list server))
+
+(deffoo nnmh-request-expire-articles (articles newsgroup
+ &optional server force)
+ (nnmh-possibly-change-directory newsgroup server)
+ (let* ((active-articles
+ (mapcar
+ (function
+ (lambda (name)
+ (string-to-int name)))
+ (directory-files nnmh-current-directory nil "^[0-9]+$" t)))
+ (is-old t)
+ article rest mod-time)
+ (nnmail-activate 'nnmh)
+
+ (while (and articles is-old)
+ (setq article (concat nnmh-current-directory
+ (int-to-string (car articles))))
+ (when (setq mod-time (nth 5 (file-attributes article)))
+ (if (and (nnmh-deletable-article-p newsgroup (car articles))
+ (setq is-old
+ (nnmail-expired-article-p newsgroup mod-time force)))
+ (progn
+ (nnheader-message 5 "Deleting article %s in %s..."
+ article newsgroup)
+ (condition-case ()
+ (funcall nnmail-delete-file-function article)
+ (file-error
+ (nnheader-message 1 "Couldn't delete article %s in %s"
+ article newsgroup)
+ (push (car articles) rest))))
+ (push (car articles) rest)))
+ (setq articles (cdr articles)))
+ (message "")
+ (nconc rest articles)))
+
+(deffoo nnmh-close-group (group &optional server)
+ t)
+
+(deffoo nnmh-request-move-article
+ (article group server accept-form &optional last)
+ (let ((buf (get-buffer-create " *nnmh move*"))
+ result)
+ (and
+ (nnmh-deletable-article-p group article)
+ (nnmh-request-article article group server)
+ (save-excursion
+ (set-buffer buf)
+ (erase-buffer)
+ (insert-buffer-substring nntp-server-buffer)
+ (setq result (eval accept-form))
+ (kill-buffer (current-buffer))
+ result)
+ (progn
+ (nnmh-possibly-change-directory group server)
+ (condition-case ()
+ (funcall nnmail-delete-file-function
+ (concat nnmh-current-directory (int-to-string article)))
+ (file-error nil))))
+ result))
+
+(deffoo nnmh-request-accept-article (group &optional server last noinsert)
+ (nnmh-possibly-change-directory group server)
+ (nnmail-check-syntax)
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (prog1
+ (if (stringp group)
+ (and
+ (nnmail-activate 'nnmh)
+ (if noinsert
+ (nnmh-active-number group)
+ (car (nnmh-save-mail
+ (list (cons group (nnmh-active-number group)))
+ noinsert))))
+ (and
+ (nnmail-activate 'nnmh)
+ (let ((res (nnmail-article-group 'nnmh-active-number)))
+ (if (and (null res)
+ (yes-or-no-p "Moved to `junk' group; delete article? "))
+ 'junk
+ (car (nnmh-save-mail res noinsert))))))
+ (when (and last nnmail-cache-accepted-message-ids)
+ (nnmail-cache-close))))
+
+(deffoo nnmh-request-replace-article (article group buffer)
+ (nnmh-possibly-change-directory group)
+ (save-excursion
+ (set-buffer buffer)
+ (nnmh-possibly-create-directory group)
+ (ignore-errors
+ (nnmail-write-region
+ (point-min) (point-max)
+ (concat nnmh-current-directory (int-to-string article))
+ nil (if (nnheader-be-verbose 5) nil 'nomesg))
+ t)))
+
+(deffoo nnmh-request-create-group (group &optional server args)
+ (nnmail-activate 'nnmh)
+ (unless (assoc group nnmh-group-alist)
+ (let (active)
+ (push (list group (setq active (cons 1 0)))
+ nnmh-group-alist)
+ (nnmh-possibly-create-directory group)
+ (nnmh-possibly-change-directory group server)
+ (let ((articles (mapcar
+ (lambda (file)
+ (string-to-int file))
+ (directory-files
+ nnmh-current-directory nil "^[0-9]+$"))))
+ (when articles
+ (setcar active (apply 'min articles))
+ (setcdr active (apply 'max articles))))))
+ t)
+
+(deffoo nnmh-request-delete-group (group &optional force server)
+ (nnmh-possibly-change-directory group server)
+ ;; Delete all articles in GROUP.
+ (if (not force)
+ () ; Don't delete the articles.
+ (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$")))
+ (while articles
+ (when (file-writable-p (car articles))
+ (nnheader-message 5 "Deleting article %s in %s..."
+ (car articles) group)
+ (funcall nnmail-delete-file-function (car articles)))
+ (setq articles (cdr articles))))
+ ;; Try to delete the directory itself.
+ (ignore-errors
+ (delete-directory nnmh-current-directory)))
+ ;; Remove the group from all structures.
+ (setq nnmh-group-alist
+ (delq (assoc group nnmh-group-alist) nnmh-group-alist)
+ nnmh-current-directory nil)
+ t)
+
+(deffoo nnmh-request-rename-group (group new-name &optional server)
+ (nnmh-possibly-change-directory group server)
+ (let ((new-dir (nnmail-group-pathname new-name nnmh-directory))
+ (old-dir (nnmail-group-pathname group nnmh-directory)))
+ (when (ignore-errors
+ (make-directory new-dir t)
+ t)
+ ;; We move the articles file by file instead of renaming
+ ;; the directory -- there may be subgroups in this group.
+ ;; One might be more clever, I guess.
+ (let ((files (nnheader-article-to-file-alist old-dir)))
+ (while files
+ (rename-file
+ (concat old-dir (cdar files))
+ (concat new-dir (cdar files)))
+ (pop files)))
+ (when (<= (length (directory-files old-dir)) 2)
+ (ignore-errors
+ (delete-directory old-dir)))
+ ;; That went ok, so we change the internal structures.
+ (let ((entry (assoc group nnmh-group-alist)))
+ (when entry
+ (setcar entry new-name))
+ (setq nnmh-current-directory nil)
+ t))))
+
+(nnoo-define-skeleton nnmh)
+
+\f
+;;; Internal functions.
+
+(defun nnmh-possibly-change-directory (newsgroup &optional server)
+ (when (and server
+ (not (nnmh-server-opened server)))
+ (nnmh-open-server server))
+ (when newsgroup
+ (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))
+ (pathname-coding-system 'binary))
+ (if (file-directory-p pathname)
+ (setq nnmh-current-directory pathname)
+ (error "No such newsgroup: %s" newsgroup)))))
+
+(defun nnmh-possibly-create-directory (group)
+ (let (dir dirs)
+ (setq dir (nnmail-group-pathname group nnmh-directory))
+ (while (not (file-directory-p dir))
+ (push dir dirs)
+ (setq dir (file-name-directory (directory-file-name dir))))
+ (while dirs
+ (when (make-directory (directory-file-name (car dirs)))
+ (error "Could not create directory %s" (car dirs)))
+ (nnheader-message 5 "Creating mail directory %s" (car dirs))
+ (setq dirs (cdr dirs)))))
+
+(defun nnmh-save-mail (group-art &optional noinsert)
+ "Called narrowed to an article."
+ (unless noinsert
+ (nnmail-insert-lines)
+ (nnmail-insert-xref group-art))
+ (run-hooks 'nnmail-prepare-save-mail-hook)
+ (run-hooks 'nnmh-prepare-save-mail-hook)
+ (goto-char (point-min))
+ (while (looking-at "From ")
+ (replace-match "X-From-Line: ")
+ (forward-line 1))
+ ;; We save the article in all the newsgroups it belongs in.
+ (let ((ga group-art)
+ first)
+ (while ga
+ (nnmh-possibly-create-directory (caar ga))
+ (let ((file (concat (nnmail-group-pathname
+ (caar ga) nnmh-directory)
+ (int-to-string (cdar ga)))))
+ (if first
+ ;; It was already saved, so we just make a hard link.
+ (funcall nnmail-crosspost-link-function first file t)
+ ;; Save the article.
+ (nnmail-write-region (point-min) (point-max) file nil nil)
+ (setq first file)))
+ (setq ga (cdr ga))))
+ group-art)
+
+(defun nnmh-active-number (group)
+ "Compute the next article number in GROUP."
+ (let ((active (cadr (assoc group nnmh-group-alist)))
+ (dir (nnmail-group-pathname group nnmh-directory))
+ (pathname-coding-system 'binary))
+ (unless active
+ ;; The group wasn't known to nnmh, so we just create an active
+ ;; entry for it.
+ (setq active (cons 1 0))
+ (push (list group active) nnmh-group-alist)
+ (unless (file-exists-p dir)
+ (make-directory dir))
+ ;; Find the highest number in the group.
+ (let ((files (sort
+ (mapcar
+ (lambda (f)
+ (string-to-int f))
+ (directory-files dir nil "^[0-9]+$"))
+ '>)))
+ (when files
+ (setcdr active (car files)))))
+ (setcdr active (1+ (cdr active)))
+ (while (file-exists-p
+ (concat (nnmail-group-pathname group nnmh-directory)
+ (int-to-string (cdr active))))
+ (setcdr active (1+ (cdr active))))
+ (cdr active)))
+
+(defun nnmh-update-gnus-unreads (group)
+ ;; Go through the .nnmh-articles file and compare with the actual
+ ;; articles in this folder. The articles that are "new" will be
+ ;; marked as unread by Gnus.
+ (let* ((dir nnmh-current-directory)
+ (files (sort (mapcar (function (lambda (name) (string-to-int name)))
+ (directory-files nnmh-current-directory
+ nil "^[0-9]+$" t))
+ '<))
+ (nnmh-file (concat dir ".nnmh-articles"))
+ new articles)
+ ;; Load the .nnmh-articles file.
+ (when (file-exists-p nnmh-file)
+ (setq articles
+ (let (nnmh-newsgroup-articles)
+ (ignore-errors (load nnmh-file nil t t))
+ nnmh-newsgroup-articles)))
+ ;; Add all new articles to the `new' list.
+ (let ((art files))
+ (while art
+ (unless (assq (car art) articles)
+ (push (car art) new))
+ (setq art (cdr art))))
+ ;; Remove all deleted articles.
+ (let ((art articles))
+ (while art
+ (unless (memq (caar art) files)
+ (setq articles (delq (car art) articles)))
+ (setq art (cdr art))))
+ ;; Check whether the articles really are the ones that Gnus thinks
+ ;; they are by looking at the time-stamps.
+ (let ((arts articles)
+ art)
+ (while (setq art (pop arts))
+ (when (not (equal
+ (nth 5 (file-attributes
+ (concat dir (int-to-string (car art)))))
+ (cdr art)))
+ (setq articles (delq art articles))
+ (push (car art) new))))
+ ;; Go through all the new articles and add them, and their
+ ;; time-stamps, to the list.
+ (setq articles
+ (nconc articles
+ (mapcar
+ (lambda (art)
+ (cons art
+ (nth 5 (file-attributes
+ (concat dir (int-to-string art))))))
+ new)))
+ ;; Make Gnus mark all new articles as unread.
+ (when new
+ (gnus-make-articles-unread
+ (gnus-group-prefixed-name group (list 'nnmh ""))
+ (setq new (sort new '<))))
+ ;; Sort the article list with highest numbers first.
+ (setq articles (sort articles (lambda (art1 art2)
+ (> (car art1) (car art2)))))
+ ;; Finally write this list back to the .nnmh-articles file.
+ (nnheader-temp-write nnmh-file
+ (insert ";; Gnus article active file for " group "\n\n")
+ (insert "(setq nnmh-newsgroup-articles '")
+ (gnus-prin1 articles)
+ (insert ")\n"))))
+
+(defun nnmh-deletable-article-p (group article)
+ "Say whether ARTICLE in GROUP can be deleted."
+ (let ((path (concat nnmh-current-directory (int-to-string article))))
+ ;; Writable.
+ (and (file-writable-p path)
+ (or
+ ;; We can never delete the last article in the group.
+ (not (eq (cdr (nth 1 (assoc group nnmh-group-alist)))
+ article))
+ ;; Well, we can.
+ nnmh-allow-delete-final))))
+
+(provide 'nnmh)
+
+;;; nnmh.el ends here
--- /dev/null
+;;; nnml.el --- mail spool access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmail)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nnml)
+
+(defvoo nnml-directory message-directory
+ "Spool directory for the nnml mail backend.")
+
+(defvoo nnml-active-file
+ (concat (file-name-as-directory nnml-directory) "active")
+ "Mail active file.")
+
+(defvoo nnml-newsgroups-file
+ (concat (file-name-as-directory nnml-directory) "newsgroups")
+ "Mail newsgroups description file.")
+
+(defvoo nnml-get-new-mail t
+ "If non-nil, nnml will check the incoming mail file and split the mail.")
+
+(defvoo nnml-nov-is-evil nil
+ "If non-nil, Gnus will never generate and use nov databases for mail groups.
+Using nov databases will speed up header fetching considerably.
+This variable shouldn't be flipped much. If you have, for some reason,
+set this to t, and want to set it to nil again, you should always run
+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-prepare-save-mail-hook nil
+ "Hook run narrowed to an article before saving.")
+
+(defvoo nnml-inhibit-expiry nil
+ "If non-nil, inhibit expiry.")
+
+
+\f
+
+(defconst nnml-version "nnml 1.0"
+ "nnml version.")
+
+(defvoo nnml-nov-file-name ".overview")
+
+(defvoo nnml-current-directory nil)
+(defvoo nnml-current-group nil)
+(defvoo nnml-status-string "")
+(defvoo nnml-nov-buffer-alist nil)
+(defvoo nnml-group-alist nil)
+(defvoo nnml-active-timestamp nil)
+(defvoo nnml-article-file-alist nil)
+
+(defvoo nnml-generate-active-function 'nnml-generate-active-info)
+
+\f
+
+;;; Interface functions.
+
+(nnoo-define-basics nnml)
+
+(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
+ (when (nnml-possibly-change-directory group server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let ((file nil)
+ (number (length sequence))
+ (count 0)
+ ;; 1997/8/12 by MORIOKA Tomohiko
+ ;; for XEmacs/mule.
+ (pathname-coding-system 'binary)
+ beg article)
+ (if (stringp (car sequence))
+ 'headers
+ (if (nnml-retrieve-headers-with-nov sequence fetch-old)
+ 'nov
+ (while sequence
+ (setq article (car sequence))
+ (setq file (nnml-article-to-file article))
+ (when (and file
+ (file-exists-p file)
+ (not (file-directory-p file)))
+ (insert (format "221 %d Article retrieved.\n" article))
+ (setq beg (point))
+ (nnheader-insert-head file)
+ (goto-char beg)
+ (if (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (goto-char (point-max))
+ (insert "\n\n"))
+ (insert ".\n")
+ (delete-region (point) (point-max)))
+ (setq sequence (cdr sequence))
+ (setq count (1+ count))
+ (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)
+ (zerop (% count 20))
+ (nnheader-message 6 "nnml: Receiving headers... %d%%"
+ (/ (* count 100) number))))
+
+ (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)
+ (nnheader-message 6 "nnml: Receiving headers...done"))
+
+ (nnheader-fold-continuation-lines)
+ 'headers))))))
+
+(deffoo nnml-open-server (server &optional defs)
+ (nnoo-change-server 'nnml server defs)
+ (when (not (file-exists-p nnml-directory))
+ (condition-case ()
+ (make-directory nnml-directory t)
+ (error)))
+ (cond
+ ((not (file-exists-p nnml-directory))
+ (nnml-close-server)
+ (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
+ ((not (file-directory-p (file-truename nnml-directory)))
+ (nnml-close-server)
+ (nnheader-report 'nnml "Not a directory: %s" nnml-directory))
+ (t
+ (nnheader-report 'nnml "Opened server %s using directory %s"
+ server nnml-directory)
+ t)))
+
+(defun nnml-request-regenerate (server)
+ (nnml-possibly-change-directory nil server)
+ (nnml-generate-nov-databases)
+ t)
+
+(deffoo nnml-request-article (id &optional group server buffer)
+ (nnml-possibly-change-directory group server)
+ (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
+ ;; 1997/8/12 by MORIOKA Tomohiko
+ ;; for XEmacs/mule.
+ (pathname-coding-system 'binary)
+ path gpath group-num)
+ (if (stringp id)
+ (when (and (setq group-num (nnml-find-group-number id))
+ (cdr
+ (assq (cdr group-num)
+ (nnheader-article-to-file-alist
+ (setq gpath
+ (nnmail-group-pathname
+ (car group-num)
+ nnml-directory))))))
+ (setq path (concat gpath (int-to-string (cdr group-num)))))
+ (setq path (nnml-article-to-file id)))
+ (cond
+ ((not path)
+ (nnheader-report 'nnml "No such article: %s" id))
+ ((not (file-exists-p path))
+ (nnheader-report 'nnml "No such file: %s" path))
+ ((file-directory-p path)
+ (nnheader-report 'nnml "File is a directory: %s" path))
+ ((not (save-excursion (nnmail-find-file path)))
+ (nnheader-report 'nnml "Couldn't read file: %s" path))
+ (t
+ (nnheader-report 'nnml "Article %s retrieved" id)
+ ;; We return the article number.
+ (cons (if group-num (car group-num) group)
+ (string-to-int (file-name-nondirectory path)))))))
+
+(deffoo nnml-request-group (group &optional server dont-check)
+ (let ((pathname-coding-system 'binary))
+ (cond
+ ((not (nnml-possibly-change-directory group server))
+ (nnheader-report 'nnml "Invalid group (no such directory)"))
+ ((not (file-exists-p nnml-current-directory))
+ (nnheader-report 'nnml "Directory %s does not exist"
+ nnml-current-directory))
+ ((not (file-directory-p nnml-current-directory))
+ (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
+ (dont-check
+ (nnheader-report 'nnml "Group %s selected" group)
+ t)
+ (t
+ (nnheader-re-read-dir nnml-current-directory)
+ (nnmail-activate 'nnml)
+ (let ((active (nth 1 (assoc group nnml-group-alist))))
+ (if (not active)
+ (nnheader-report 'nnml "No such group: %s" group)
+ (nnheader-report 'nnml "Selected group %s" group)
+ (nnheader-insert "211 %d %d %d %s\n"
+ (max (1+ (- (cdr active) (car active))) 0)
+ (car active) (cdr active) group)))))))
+
+(deffoo nnml-request-scan (&optional group server)
+ (setq nnml-article-file-alist nil)
+ (nnml-possibly-change-directory group server)
+ (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
+
+(deffoo nnml-close-group (group &optional server)
+ (setq nnml-article-file-alist nil)
+ t)
+
+(deffoo nnml-request-create-group (group &optional server args)
+ (nnmail-activate 'nnml)
+ (unless (assoc group nnml-group-alist)
+ (let (active)
+ (push (list group (setq active (cons 1 0)))
+ nnml-group-alist)
+ (nnml-possibly-create-directory group)
+ (nnml-possibly-change-directory group server)
+ (let ((articles (nnheader-directory-articles nnml-current-directory)))
+ (when articles
+ (setcar active (apply 'min articles))
+ (setcdr active (apply 'max articles))))
+ (nnmail-save-active nnml-group-alist nnml-active-file)))
+ t)
+
+(deffoo nnml-request-list (&optional server)
+ (save-excursion
+ ;; 1997/8/12 by MORIOKA Tomohiko
+ ;; for XEmacs/mule.
+ (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
+ (pathname-coding-system 'binary)) ; for XEmacs/mule
+ (nnmail-find-file nnml-active-file)
+ )
+ (setq nnml-group-alist (nnmail-get-active))
+ t))
+
+(deffoo nnml-request-newgroups (date &optional server)
+ (nnml-request-list server))
+
+(deffoo nnml-request-list-newsgroups (&optional server)
+ (save-excursion
+ (nnmail-find-file nnml-newsgroups-file)))
+
+(deffoo nnml-request-expire-articles (articles group
+ &optional server force)
+ (nnml-possibly-change-directory group server)
+ (let ((active-articles
+ (nnheader-directory-articles nnml-current-directory))
+ (is-old t)
+ article rest mod-time number)
+ (nnmail-activate 'nnml)
+
+ (while (and articles is-old)
+ (when (setq article (nnml-article-to-file (setq number (pop articles))))
+ (when (setq mod-time (nth 5 (file-attributes article)))
+ (if (and (nnml-deletable-article-p group number)
+ (setq is-old
+ (nnmail-expired-article-p group mod-time force
+ nnml-inhibit-expiry)))
+ (progn
+ (nnheader-message 5 "Deleting article %s in %s"
+ article group)
+ (condition-case ()
+ (funcall nnmail-delete-file-function article)
+ (file-error
+ (push number rest)))
+ (setq active-articles (delq number active-articles))
+ (nnml-nov-delete-article group number))
+ (push number rest)))))
+ (let ((active (nth 1 (assoc group nnml-group-alist))))
+ (when active
+ (setcar active (or (and active-articles
+ (apply 'min active-articles))
+ (1+ (cdr active)))))
+ (nnmail-save-active nnml-group-alist nnml-active-file))
+ (nnml-save-nov)
+ (nconc rest articles)))
+
+(deffoo nnml-request-move-article
+ (article group server accept-form &optional last)
+ (let ((buf (get-buffer-create " *nnml move*"))
+ result)
+ (nnml-possibly-change-directory group server)
+ (nnml-update-file-alist)
+ (and
+ (nnml-deletable-article-p group article)
+ (nnml-request-article article group server)
+ (save-excursion
+ (set-buffer buf)
+ (insert-buffer-substring nntp-server-buffer)
+ (setq result (eval accept-form))
+ (kill-buffer (current-buffer))
+ result)
+ (progn
+ (nnml-possibly-change-directory group server)
+ (condition-case ()
+ (funcall nnmail-delete-file-function
+ (nnml-article-to-file article))
+ (file-error nil))
+ (nnml-nov-delete-article group article)
+ (when last
+ (nnml-save-nov)
+ (nnmail-save-active nnml-group-alist nnml-active-file))))
+ result))
+
+(deffoo nnml-request-accept-article (group &optional server last)
+ (nnml-possibly-change-directory group server)
+ (nnmail-check-syntax)
+ (let (result)
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (if (stringp group)
+ (and
+ (nnmail-activate 'nnml)
+ (setq result (car (nnml-save-mail
+ (list (cons group (nnml-active-number group))))))
+ (progn
+ (nnmail-save-active nnml-group-alist nnml-active-file)
+ (and last (nnml-save-nov))))
+ (and
+ (nnmail-activate 'nnml)
+ (if (and (not (setq result (nnmail-article-group 'nnml-active-number)))
+ (yes-or-no-p "Moved to `junk' group; delete article? "))
+ (setq result 'junk)
+ (setq result (car (nnml-save-mail result))))
+ (when last
+ (nnmail-save-active nnml-group-alist nnml-active-file)
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-close))
+ (nnml-save-nov))))
+ result))
+
+(deffoo nnml-request-replace-article (article group buffer)
+ (nnml-possibly-change-directory group)
+ (save-excursion
+ (set-buffer buffer)
+ (nnml-possibly-create-directory group)
+ (let ((chars (nnmail-insert-lines))
+ (art (concat (int-to-string article) "\t"))
+ headers)
+ (when (condition-case ()
+ (progn
+ (nnmail-write-region
+ (point-min) (point-max)
+ (or (nnml-article-to-file article)
+ (concat nnml-current-directory
+ (int-to-string article)))
+ nil (if (nnheader-be-verbose 5) nil 'nomesg))
+ t)
+ (error nil))
+ (setq headers (nnml-parse-head chars article))
+ ;; Replace the NOV line in the NOV file.
+ (save-excursion
+ (set-buffer (nnml-open-nov group))
+ (goto-char (point-min))
+ (if (or (looking-at art)
+ (search-forward (concat "\n" art) nil t))
+ ;; Delete the old NOV line.
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point)))
+ ;; The line isn't here, so we have to find out where
+ ;; we should insert it. (This situation should never
+ ;; occur, but one likes to make sure...)
+ (while (and (looking-at "[0-9]+\t")
+ (< (string-to-int
+ (buffer-substring
+ (match-beginning 0) (match-end 0)))
+ article)
+ (zerop (forward-line 1)))))
+ (beginning-of-line)
+ (nnheader-insert-nov headers)
+ (nnml-save-nov)
+ t)))))
+
+(deffoo nnml-request-delete-group (group &optional force server)
+ (nnml-possibly-change-directory group server)
+ (when force
+ ;; Delete all articles in GROUP.
+ (let ((articles
+ (directory-files
+ nnml-current-directory t
+ (concat nnheader-numerical-short-files
+ "\\|" (regexp-quote nnml-nov-file-name) "$")))
+ article)
+ (while articles
+ (setq article (pop articles))
+ (when (file-writable-p article)
+ (nnheader-message 5 "Deleting article %s in %s..." article group)
+ (funcall nnmail-delete-file-function article))))
+ ;; Try to delete the directory itself.
+ (condition-case ()
+ (delete-directory nnml-current-directory)
+ (error nil)))
+ ;; Remove the group from all structures.
+ (setq nnml-group-alist
+ (delq (assoc group nnml-group-alist) nnml-group-alist)
+ nnml-current-group nil
+ nnml-current-directory nil)
+ ;; Save the active file.
+ (nnmail-save-active nnml-group-alist nnml-active-file)
+ t)
+
+(deffoo nnml-request-rename-group (group new-name &optional server)
+ (nnml-possibly-change-directory group server)
+ (let ((new-dir (nnmail-group-pathname new-name nnml-directory))
+ (old-dir (nnmail-group-pathname group nnml-directory)))
+ (when (condition-case ()
+ (progn
+ (make-directory new-dir t)
+ t)
+ (error nil))
+ ;; We move the articles file by file instead of renaming
+ ;; the directory -- there may be subgroups in this group.
+ ;; One might be more clever, I guess.
+ (let ((files (nnheader-article-to-file-alist old-dir)))
+ (while files
+ (rename-file
+ (concat old-dir (cdar files))
+ (concat new-dir (cdar files)))
+ (pop files)))
+ ;; Move .overview file.
+ (let ((overview (concat old-dir nnml-nov-file-name)))
+ (when (file-exists-p overview)
+ (rename-file overview (concat new-dir nnml-nov-file-name))))
+ (when (<= (length (directory-files old-dir)) 2)
+ (condition-case ()
+ (delete-directory old-dir)
+ (error nil)))
+ ;; That went ok, so we change the internal structures.
+ (let ((entry (assoc group nnml-group-alist)))
+ (when entry
+ (setcar entry new-name))
+ (setq nnml-current-directory nil
+ nnml-current-group nil)
+ ;; Save the new group alist.
+ (nnmail-save-active nnml-group-alist nnml-active-file)
+ t))))
+
+(deffoo nnml-set-status (article name value &optional group server)
+ (nnml-possibly-change-directory group server)
+ (let ((file (nnml-article-to-file article)))
+ (cond
+ ((not (file-exists-p file))
+ (nnheader-report 'nnml "File %s does not exist" file))
+ (t
+ (nnheader-temp-write file
+ (nnheader-insert-file-contents file)
+ (nnmail-replace-status name value))
+ t))))
+
+\f
+;;; Internal functions.
+
+(defun nnml-article-to-file (article)
+ (nnml-update-file-alist)
+ (let (file)
+ (if (setq file (cdr (assq article nnml-article-file-alist)))
+ (concat nnml-current-directory file)
+ ;; Just to make sure nothing went wrong when reading over NFS --
+ ;; check once more.
+ (when (file-exists-p
+ (setq file (concat nnml-current-directory "/"
+ (number-to-string article))))
+ (nnml-update-file-alist t)
+ file))))
+
+(defun nnml-deletable-article-p (group article)
+ "Say whether ARTICLE in GROUP can be deleted."
+ (let (path)
+ (when (setq path (nnml-article-to-file article))
+ (when (file-writable-p path)
+ (or (not nnmail-keep-last-article)
+ (not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
+ article)))))))
+
+;; Find an article number in the current group given the Message-ID.
+(defun nnml-find-group-number (id)
+ (save-excursion
+ (set-buffer (get-buffer-create " *nnml id*"))
+ (buffer-disable-undo (current-buffer))
+ (let ((alist nnml-group-alist)
+ number)
+ ;; We want to look through all .overview files, but we want to
+ ;; start with the one in the current directory. It seems most
+ ;; likely that the article we are looking for is in that group.
+ (if (setq number (nnml-find-id nnml-current-group id))
+ (cons nnml-current-group number)
+ ;; It wasn't there, so we look through the other groups as well.
+ (while (and (not number)
+ alist)
+ (or (string= (caar alist) nnml-current-group)
+ (setq number (nnml-find-id (caar alist) id)))
+ (or number
+ (setq alist (cdr alist))))
+ (and number
+ (cons (caar alist) number))))))
+
+(defun nnml-find-id (group id)
+ (erase-buffer)
+ (let ((nov (concat (nnmail-group-pathname group nnml-directory)
+ nnml-nov-file-name))
+ number found)
+ (when (file-exists-p nov)
+ (nnheader-insert-file-contents nov)
+ (while (and (not found)
+ (search-forward id nil t)) ; We find the ID.
+ ;; And the id is in the fourth field.
+ (if (not (and (search-backward "\t" nil t 4)
+ (not (search-backward"\t" (gnus-point-at-bol) t))))
+ (forward-line 1)
+ (beginning-of-line)
+ (setq found t)
+ ;; We return the article number.
+ (setq number
+ (condition-case ()
+ (read (current-buffer))
+ (error nil)))))
+ number)))
+
+(defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
+ (if (or gnus-nov-is-evil nnml-nov-is-evil)
+ nil
+ (let ((nov (concat nnml-current-directory nnml-nov-file-name)))
+ (when (file-exists-p nov)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (nnheader-insert-file-contents nov)
+ (if (and fetch-old
+ (not (numberp fetch-old)))
+ t ; Don't remove anything.
+ (nnheader-nov-delete-outside-range
+ (if fetch-old (max 1 (- (car articles) fetch-old))
+ (car articles))
+ (car (last articles)))
+ t))))))
+
+(defun nnml-possibly-change-directory (group &optional server)
+ (when (and server
+ (not (nnml-server-opened server)))
+ (nnml-open-server server))
+ (if (not group)
+ t
+ (let ((pathname (nnmail-group-pathname group nnml-directory))
+ ;; 1997/8/14 by MORIOKA Tomohiko
+ ;; for XEmacs/mule.
+ (pathname-coding-system 'binary))
+ (when (not (equal pathname nnml-current-directory))
+ (setq nnml-current-directory pathname
+ nnml-current-group group
+ nnml-article-file-alist nil))
+ (file-exists-p nnml-current-directory))))
+
+(defun nnml-possibly-create-directory (group)
+ (let (dir dirs)
+ (setq dir (nnmail-group-pathname group nnml-directory))
+ (while (not (file-directory-p dir))
+ (push dir dirs)
+ (setq dir (file-name-directory (directory-file-name dir))))
+ (while dirs
+ (make-directory (directory-file-name (car dirs)))
+ (nnheader-message 5 "Creating mail directory %s" (car dirs))
+ (setq dirs (cdr dirs)))))
+
+(defun nnml-save-mail (group-art)
+ "Called narrowed to an article."
+ (let (chars headers)
+ (setq chars (nnmail-insert-lines))
+ (nnmail-insert-xref group-art)
+ (run-hooks 'nnmail-prepare-save-mail-hook)
+ (run-hooks 'nnml-prepare-save-mail-hook)
+ (goto-char (point-min))
+ (while (looking-at "From ")
+ (replace-match "X-From-Line: ")
+ (forward-line 1))
+ ;; We save the article in all the groups it belongs in.
+ (let ((ga group-art)
+ first)
+ (while ga
+ (nnml-possibly-create-directory (caar ga))
+ (let ((file (concat (nnmail-group-pathname
+ (caar ga) nnml-directory)
+ (int-to-string (cdar ga)))))
+ (if first
+ ;; It was already saved, so we just make a hard link.
+ (funcall nnmail-crosspost-link-function first file t)
+ ;; Save the article.
+ (nnmail-write-region (point-min) (point-max) file nil
+ (if (nnheader-be-verbose 5) nil 'nomesg))
+ (setq first file)))
+ (setq ga (cdr ga))))
+ ;; Generate a nov line for this article. We generate the nov
+ ;; line after saving, because nov generation destroys the
+ ;; header.
+ (setq headers (nnml-parse-head chars))
+ ;; Output the nov line to all nov databases that should have it.
+ (let ((ga group-art))
+ (while ga
+ (nnml-add-nov (caar ga) (cdar ga) headers)
+ (setq ga (cdr ga))))
+ group-art))
+
+(defun nnml-active-number (group)
+ "Compute the next article number in GROUP."
+ (let ((active (cadr (assoc group nnml-group-alist))))
+ ;; The group wasn't known to nnml, so we just create an active
+ ;; entry for it.
+ (unless active
+ ;; Perhaps the active file was corrupt? See whether
+ ;; there are any articles in this group.
+ (nnml-possibly-create-directory group)
+ (nnml-possibly-change-directory group)
+ (unless nnml-article-file-alist
+ (setq nnml-article-file-alist
+ (sort
+ (nnheader-article-to-file-alist nnml-current-directory)
+ 'car-less-than-car)))
+ (setq active
+ (if nnml-article-file-alist
+ (cons (caar nnml-article-file-alist)
+ (caar (last nnml-article-file-alist)))
+ (cons 1 0)))
+ (push (list group active) nnml-group-alist))
+ (setcdr active (1+ (cdr active)))
+ (while (file-exists-p
+ (concat (nnmail-group-pathname group nnml-directory)
+ (int-to-string (cdr active))))
+ (setcdr active (1+ (cdr active))))
+ (cdr active)))
+
+(defun nnml-add-nov (group article headers)
+ "Add a nov line for the GROUP base."
+ (save-excursion
+ (set-buffer (nnml-open-nov group))
+ (goto-char (point-max))
+ (mail-header-set-number headers article)
+ (nnheader-insert-nov headers)))
+
+(defsubst nnml-header-value ()
+ (buffer-substring (match-end 0) (progn (end-of-line) (point))))
+
+(defun nnml-parse-head (chars &optional number)
+ "Parse the head of the current buffer."
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (narrow-to-region
+ (point)
+ (1- (or (search-forward "\n\n" nil t) (point-max))))
+ ;; Fold continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ ;; Remove any tabs; they are too confusing.
+ (subst-char-in-region (point-min) (point-max) ?\t ? )
+ (let ((headers (nnheader-parse-head t)))
+ (mail-header-set-chars headers chars)
+ (mail-header-set-number headers number)
+ headers))))
+
+(defun nnml-open-nov (group)
+ (or (cdr (assoc group nnml-nov-buffer-alist))
+ (let ((buffer (nnheader-find-file-noselect
+ (concat (nnmail-group-pathname group nnml-directory)
+ nnml-nov-file-name))))
+ (save-excursion
+ (set-buffer buffer)
+ (buffer-disable-undo (current-buffer)))
+ (push (cons group buffer) nnml-nov-buffer-alist)
+ buffer)))
+
+(defun nnml-save-nov ()
+ (save-excursion
+ (while nnml-nov-buffer-alist
+ (when (buffer-name (cdar nnml-nov-buffer-alist))
+ (set-buffer (cdar nnml-nov-buffer-alist))
+ (when (buffer-modified-p)
+ (nnmail-write-region 1 (point-max) (buffer-file-name) nil 'nomesg))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer)))
+ (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
+
+;;;###autoload
+(defun nnml-generate-nov-databases ()
+ "Generate NOV databases in all nnml directories."
+ (interactive)
+ ;; Read the active file to make sure we don't re-use articles
+ ;; numbers in empty groups.
+ (nnmail-activate 'nnml)
+ (nnml-open-server (or (nnoo-current-server 'nnml) ""))
+ (setq nnml-directory (expand-file-name nnml-directory))
+ ;; Recurse down the directories.
+ (nnml-generate-nov-databases-1 nnml-directory nil t)
+ ;; Save the active file.
+ (nnmail-save-active nnml-group-alist nnml-active-file))
+
+(defun nnml-generate-nov-databases-1 (dir &optional seen no-active)
+ "Regenerate the NOV database in DIR."
+ (interactive "DRegenerate NOV in: ")
+ (setq dir (file-name-as-directory dir))
+ ;; Only scan this sub-tree if we haven't been here yet.
+ (unless (member (file-truename dir) seen)
+ (push (file-truename dir) seen)
+ ;; We descend recursively
+ (let ((dirs (directory-files dir t nil t))
+ dir)
+ (while (setq dir (pop dirs))
+ (when (and (not (member (file-name-nondirectory dir) '("." "..")))
+ (file-directory-p dir))
+ (nnml-generate-nov-databases-1 dir seen))))
+ ;; Do this directory.
+ (let ((files (sort (nnheader-article-to-file-alist dir)
+ 'car-less-than-car)))
+ (when files
+ (funcall nnml-generate-active-function dir)
+ ;; Generate the nov file.
+ (nnml-generate-nov-file dir files)
+ (unless no-active
+ (nnmail-save-active nnml-group-alist nnml-active-file))))))
+
+(defvar files)
+(defun nnml-generate-active-info (dir)
+ ;; Update the active info for this group.
+ (let ((group (nnheader-file-to-group
+ (directory-file-name dir) nnml-directory)))
+ (setq nnml-group-alist
+ (delq (assoc group nnml-group-alist) nnml-group-alist))
+ (push (list group
+ (cons (caar files)
+ (let ((f files))
+ (while (cdr f) (setq f (cdr f)))
+ (caar f))))
+ nnml-group-alist)))
+
+(defun nnml-generate-nov-file (dir files)
+ (let* ((dir (file-name-as-directory dir))
+ (nov (concat dir nnml-nov-file-name))
+ (nov-buffer (get-buffer-create " *nov*"))
+ chars file headers)
+ (save-excursion
+ ;; Init the nov buffer.
+ (set-buffer nov-buffer)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (set-buffer nntp-server-buffer)
+ ;; Delete the old NOV file.
+ (when (file-exists-p nov)
+ (funcall nnmail-delete-file-function nov))
+ (while files
+ (unless (file-directory-p (setq file (concat dir (cdar files))))
+ (erase-buffer)
+ (nnheader-insert-file-contents file)
+ (narrow-to-region
+ (goto-char (point-min))
+ (progn
+ (search-forward "\n\n" nil t)
+ (setq chars (- (point-max) (point)))
+ (max 1 (1- (point)))))
+ (unless (zerop (buffer-size))
+ (goto-char (point-min))
+ (setq headers (nnml-parse-head chars (caar files)))
+ (save-excursion
+ (set-buffer nov-buffer)
+ (goto-char (point-max))
+ (nnheader-insert-nov headers)))
+ (widen))
+ (setq files (cdr files)))
+ (save-excursion
+ (set-buffer nov-buffer)
+ (nnmail-write-region 1 (point-max) nov nil 'nomesg)
+ (kill-buffer (current-buffer))))))
+
+(defun nnml-nov-delete-article (group article)
+ (save-excursion
+ (set-buffer (nnml-open-nov group))
+ (when (nnheader-find-nov-line article)
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (when (bobp)
+ (let ((active (cadr (assoc group nnml-group-alist)))
+ num)
+ (when active
+ (if (eobp)
+ (setf (car active) (1+ (cdr active)))
+ (when (and (setq num (ignore-errors (read (current-buffer))))
+ (numberp num))
+ (setf (car active) num)))))))
+ t))
+
+(defun nnml-update-file-alist (&optional force)
+ (when (or (not nnml-article-file-alist)
+ force)
+ (setq nnml-article-file-alist
+ (nnheader-article-to-file-alist nnml-current-directory))))
+
+(provide 'nnml)
+
+;;; nnml.el ends here
--- /dev/null
+;;; nnoo.el --- OO Gnus Backends
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(eval-when-compile (require 'cl))
+
+(defvar nnoo-definition-alist nil)
+(defvar nnoo-state-alist nil)
+
+(defmacro defvoo (var init &optional doc &rest map)
+ "The same as `defvar', only takes list of variables to MAP to."
+ `(prog1
+ ,(if doc
+ `(defvar ,var ,init ,doc)
+ `(defvar ,var ,init))
+ (nnoo-define ',var ',map)))
+(put 'defvoo 'lisp-indent-function 2)
+(put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map))
+
+(defmacro deffoo (func args &rest forms)
+ "The same as `defun', only register FUNC."
+ `(prog1
+ (defun ,func ,args ,@forms)
+ (nnoo-register-function ',func)))
+(put 'deffoo 'lisp-indent-function 2)
+(put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body))
+
+(defun nnoo-register-function (func)
+ (let ((funcs (nthcdr 3 (assoc (nnoo-backend func)
+ nnoo-definition-alist))))
+ (unless funcs
+ (error "%s belongs to a backend that hasn't been declared" func))
+ (setcar funcs (cons func (car funcs)))))
+
+(defmacro nnoo-declare (backend &rest parents)
+ `(eval-and-compile
+ (push (list ',backend
+ (mapcar (lambda (p) (list p)) ',parents)
+ nil nil)
+ nnoo-definition-alist)
+ (push (list ',backend "*internal-non-initialized-backend*")
+ nnoo-state-alist)))
+(put 'nnoo-declare 'lisp-indent-function 1)
+
+(defun nnoo-parents (backend)
+ (nth 1 (assoc backend nnoo-definition-alist)))
+
+(defun nnoo-variables (backend)
+ (nth 2 (assoc backend nnoo-definition-alist)))
+
+(defun nnoo-functions (backend)
+ (nth 3 (assoc backend nnoo-definition-alist)))
+
+(defmacro nnoo-import (backend &rest imports)
+ `(nnoo-import-1 ',backend ',imports))
+(put 'nnoo-import 'lisp-indent-function 1)
+
+(defun nnoo-import-1 (backend imports)
+ (let ((call-function
+ (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function))
+ imp functions function)
+ (while (setq imp (pop imports))
+ (setq functions
+ (or (cdr imp)
+ (nnoo-functions (car imp))))
+ (while functions
+ (unless (fboundp (setq function
+ (nnoo-symbol backend (nnoo-rest-symbol
+ (car functions)))))
+ (eval `(deffoo ,function (&rest args)
+ (,call-function ',backend ',(car functions) args))))
+ (pop functions)))))
+
+(defun nnoo-parent-function (backend function args)
+ (let ((pbackend (nnoo-backend function)))
+ (nnoo-change-server pbackend (nnoo-current-server backend)
+ (cdr (assq pbackend (nnoo-parents backend))))
+ (apply function args)))
+
+(defun nnoo-execute (backend function &rest args)
+ "Execute FUNCTION on behalf of BACKEND."
+ (let ((pbackend (nnoo-backend function)))
+ (nnoo-change-server pbackend (nnoo-current-server backend)
+ (cdr (assq pbackend (nnoo-parents backend))))
+ (apply function args)))
+
+(defmacro nnoo-map-functions (backend &rest maps)
+ `(nnoo-map-functions-1 ',backend ',maps))
+(put 'nnoo-map-functions 'lisp-indent-function 1)
+
+(defun nnoo-map-functions-1 (backend maps)
+ (let (m margs i)
+ (while (setq m (pop maps))
+ (setq i 0
+ margs nil)
+ (while (< i (length (cdr m)))
+ (if (numberp (nth i (cdr m)))
+ (push `(nth ,i args) margs)
+ (push (nth i (cdr m)) margs))
+ (incf i))
+ (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
+ (&rest args)
+ (nnoo-parent-function ',backend ',(car m)
+ ,(cons 'list (nreverse margs))))))))
+
+(defun nnoo-backend (symbol)
+ (string-match "^[^-]+-" (symbol-name symbol))
+ (intern (substring (symbol-name symbol) 0 (1- (match-end 0)))))
+
+(defun nnoo-rest-symbol (symbol)
+ (string-match "^[^-]+-" (symbol-name symbol))
+ (intern (substring (symbol-name symbol) (match-end 0))))
+
+(defun nnoo-symbol (backend symbol)
+ (intern (format "%s-%s" backend symbol)))
+
+(defun nnoo-define (var map)
+ (let* ((backend (nnoo-backend var))
+ (def (assq backend nnoo-definition-alist))
+ (parents (nth 1 def)))
+ (unless def
+ (error "%s belongs to a backend that hasn't been declared" var))
+ (setcar (nthcdr 2 def)
+ (delq (assq var (nth 2 def)) (nth 2 def)))
+ (setcar (nthcdr 2 def)
+ (cons (cons var (symbol-value var))
+ (nth 2 def)))
+ (while map
+ (nconc (assq (nnoo-backend (car map)) parents)
+ (list (list (pop map) var))))))
+
+(defun nnoo-change-server (backend server defs)
+ (let* ((bstate (cdr (assq backend nnoo-state-alist)))
+ (current (car bstate))
+ (parents (nnoo-parents backend))
+ (bvariables (nnoo-variables backend))
+ state def)
+ (unless bstate
+ (push (setq bstate (list backend nil))
+ nnoo-state-alist)
+ (pop bstate))
+ (if (equal server current)
+ t
+ (nnoo-push-server backend current)
+ (setq state (or (cdr (assoc server (cddr bstate)))
+ (nnoo-variables backend)))
+ (while state
+ (set (caar state) (cdar state))
+ (pop state))
+ (setcar bstate server)
+ (unless (cdr (assoc server (cddr bstate)))
+ (while (setq def (pop defs))
+ (unless (assq (car def) bvariables)
+ (nconc bvariables
+ (list (cons (car def) (and (boundp (car def))
+ (symbol-value (car def)))))))
+ (set (car def) (cadr def))))
+ (while parents
+ (nnoo-change-server
+ (caar parents) server
+ (mapcar (lambda (def) (list (car def) (symbol-value (cadr def))))
+ (cdar parents)))
+ (pop parents))))
+ t)
+
+(defun nnoo-push-server (backend current)
+ (let ((bstate (assq backend nnoo-state-alist))
+ (defs (nnoo-variables backend)))
+ ;; Remove the old definition.
+ (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate)))
+ ;; If this is the first time we push the server (i. e., this is
+ ;; the nil server), then we update the default values of
+ ;; all the variables to reflect the current values.
+ (when (equal current "*internal-non-initialized-backend*")
+ (let ((defaults (nnoo-variables backend))
+ def)
+ (while (setq def (pop defaults))
+ (setcdr def (symbol-value (car def))))))
+ (let (state)
+ (while defs
+ (push (cons (caar defs) (symbol-value (caar defs)))
+ state)
+ (pop defs))
+ (nconc bstate (list (cons current state))))))
+
+(defsubst nnoo-current-server-p (backend server)
+ (equal (nnoo-current-server backend) server))
+
+(defun nnoo-current-server (backend)
+ (nth 1 (assq backend nnoo-state-alist)))
+
+(defun nnoo-close-server (backend &optional server)
+ (unless server
+ (setq server (nnoo-current-server backend)))
+ (when server
+ (let* ((bstate (cdr (assq backend nnoo-state-alist)))
+ (defs (assoc server (cdr bstate))))
+ (when bstate
+ (setcar bstate nil)
+ (setcdr bstate (delq defs (cdr bstate)))
+ (pop defs)
+ (while defs
+ (set (car (pop defs)) nil)))))
+ t)
+
+(defun nnoo-close (backend)
+ (setq nnoo-state-alist
+ (delq (assq backend nnoo-state-alist)
+ nnoo-state-alist))
+ t)
+
+(defun nnoo-status-message (backend server)
+ (nnheader-get-report backend))
+
+(defun nnoo-server-opened (backend server)
+ (and (nnoo-current-server-p backend server)
+ nntp-server-buffer
+ (buffer-name nntp-server-buffer)))
+
+(defmacro nnoo-define-basics (backend)
+ "Define `close-server', `server-opened' and `status-message'."
+ `(eval-and-compile
+ (nnoo-define-basics-1 ',backend)))
+
+(defun nnoo-define-basics-1 (backend)
+ (let ((functions '(close-server server-opened status-message)))
+ (while functions
+ (eval `(deffoo ,(nnoo-symbol backend (car functions))
+ (&optional server)
+ (,(nnoo-symbol 'nnoo (pop functions)) ',backend server)))))
+ (eval `(deffoo ,(nnoo-symbol backend 'open-server)
+ (server &optional defs)
+ (nnoo-change-server ',backend server defs))))
+
+(defmacro nnoo-define-skeleton (backend)
+ "Define all required backend functions for BACKEND.
+All functions will return nil and report an error."
+ `(eval-and-compile
+ (nnoo-define-skeleton-1 ',backend)))
+
+(defun nnoo-define-skeleton-1 (backend)
+ (let ((functions '(retrieve-headers
+ request-close request-article
+ request-group close-group
+ request-list request-post request-list-newsgroups))
+ function fun)
+ (while (setq function (pop functions))
+ (when (not (fboundp (setq fun (nnoo-symbol backend function))))
+ (eval `(deffoo ,fun
+ (&rest args)
+ (nnheader-report ',backend ,(format "%s-%s not implemented"
+ backend function))))))))
+(provide 'nnoo)
+
+;;; nnoo.el ends here.
--- /dev/null
+;;; nnsoup.el --- SOUP access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmail)
+(require 'gnus-soup)
+(require 'gnus-msg)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nnsoup)
+
+(defvoo nnsoup-directory "~/SOUP/"
+ "*SOUP packet directory.")
+
+(defvoo nnsoup-tmp-directory "/tmp/"
+ "*Where nnsoup will store temporary files.")
+
+(defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/")
+ "*Directory where outgoing packets will be composed.")
+
+(defvoo nnsoup-replies-format-type ?n
+ "*Format of the replies packages.")
+
+(defvoo nnsoup-replies-index-type ?n
+ "*Index type of the replies packages.")
+
+(defvoo nnsoup-active-file (concat nnsoup-directory "active")
+ "Active file.")
+
+(defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz"
+ "Format string command for packing a SOUP packet.
+The SOUP files will be inserted where the %s is in the string.
+This string MUST contain both %s and %d. The file number will be
+inserted where %d appears.")
+
+(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -"
+ "*Format string command for unpacking a SOUP packet.
+The SOUP packet file name will be inserted at the %s.")
+
+(defvoo nnsoup-packet-directory "~/"
+ "*Where nnsoup will look for incoming packets.")
+
+(defvoo nnsoup-packet-regexp "Soupout"
+ "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
+
+(defvoo nnsoup-always-save t
+ "If non nil commit the reply buffer on each message send.
+This is necessary if using message mode outside Gnus with nnsoup as a
+backend for the messages.")
+
+\f
+
+(defconst nnsoup-version "nnsoup 0.0"
+ "nnsoup version.")
+
+(defvoo nnsoup-status-string "")
+(defvoo nnsoup-group-alist nil)
+(defvoo nnsoup-current-prefix 0)
+(defvoo nnsoup-replies-list nil)
+(defvoo nnsoup-buffers nil)
+(defvoo nnsoup-current-group nil)
+(defvoo nnsoup-group-alist-touched nil)
+(defvoo nnsoup-article-alist nil)
+\f
+
+;;; Interface functions.
+
+(nnoo-define-basics nnsoup)
+
+(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old)
+ (nnsoup-possibly-change-group group)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist)))
+ (articles sequence)
+ (use-nov t)
+ useful-areas this-area-seq msg-buf)
+ (if (stringp (car sequence))
+ ;; We don't support fetching by Message-ID.
+ 'headers
+ ;; We go through all the areas and find which files the
+ ;; articles in SEQUENCE come from.
+ (while (and areas sequence)
+ ;; Peel off areas that are below sequence.
+ (while (and areas (< (cdaar areas) (car sequence)))
+ (setq areas (cdr areas)))
+ (when areas
+ ;; This is a useful area.
+ (push (car areas) useful-areas)
+ (setq this-area-seq nil)
+ ;; We take note whether this MSG has a corresponding IDX
+ ;; for later use.
+ (when (or (= (gnus-soup-encoding-index
+ (gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
+ (not (file-exists-p
+ (nnsoup-file
+ (gnus-soup-area-prefix (nth 1 (car areas)))))))
+ (setq use-nov nil))
+ ;; We assign the portion of `sequence' that is relevant to
+ ;; this MSG packet to this packet.
+ (while (and sequence (<= (car sequence) (cdaar areas)))
+ (push (car sequence) this-area-seq)
+ (setq sequence (cdr sequence)))
+ (setcar useful-areas (cons (nreverse this-area-seq)
+ (car useful-areas)))))
+
+ ;; We now have a list of article numbers and corresponding
+ ;; areas.
+ (setq useful-areas (nreverse useful-areas))
+
+ ;; Two different approaches depending on whether all the MSG
+ ;; files have corresponding IDX files. If they all do, we
+ ;; simply return the relevant IDX files and let Gnus sort out
+ ;; what lines are relevant. If some of the IDX files are
+ ;; missing, we must return HEADs for all the articles.
+ (if use-nov
+ ;; We have IDX files for all areas.
+ (progn
+ (while useful-areas
+ (goto-char (point-max))
+ (let ((b (point))
+ (number (car (nth 1 (car useful-areas))))
+ (index-buffer (nnsoup-index-buffer
+ (gnus-soup-area-prefix
+ (nth 2 (car useful-areas))))))
+ (when index-buffer
+ (insert-buffer-substring index-buffer)
+ (goto-char b)
+ ;; We have to remove the index number entires and
+ ;; insert article numbers instead.
+ (while (looking-at "[0-9]+")
+ (replace-match (int-to-string number) t t)
+ (incf number)
+ (forward-line 1))))
+ (setq useful-areas (cdr useful-areas)))
+ 'nov)
+ ;; We insert HEADs.
+ (while useful-areas
+ (setq articles (caar useful-areas)
+ useful-areas (cdr useful-areas))
+ (while articles
+ (when (setq msg-buf
+ (nnsoup-narrow-to-article
+ (car articles) (cdar useful-areas) 'head))
+ (goto-char (point-max))
+ (insert (format "221 %d Article retrieved.\n" (car articles)))
+ (insert-buffer-substring msg-buf)
+ (goto-char (point-max))
+ (insert ".\n"))
+ (setq articles (cdr articles))))
+
+ (nnheader-fold-continuation-lines)
+ 'headers)))))
+
+(deffoo nnsoup-open-server (server &optional defs)
+ (nnoo-change-server 'nnsoup server defs)
+ (when (not (file-exists-p nnsoup-directory))
+ (condition-case ()
+ (make-directory nnsoup-directory t)
+ (error t)))
+ (cond
+ ((not (file-exists-p nnsoup-directory))
+ (nnsoup-close-server)
+ (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
+ ((not (file-directory-p (file-truename nnsoup-directory)))
+ (nnsoup-close-server)
+ (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory))
+ (t
+ (nnsoup-read-active-file)
+ (nnheader-report 'nnsoup "Opened server %s using directory %s"
+ server nnsoup-directory)
+ t)))
+
+(deffoo nnsoup-request-close ()
+ (nnsoup-write-active-file)
+ (nnsoup-write-replies)
+ (gnus-soup-save-areas)
+ ;; Kill all nnsoup buffers.
+ (let (buffer)
+ (while nnsoup-buffers
+ (setq buffer (cdr (pop nnsoup-buffers)))
+ (and buffer
+ (buffer-name buffer)
+ (kill-buffer buffer))))
+ (setq nnsoup-group-alist nil
+ nnsoup-group-alist-touched nil
+ nnsoup-current-group nil
+ nnsoup-replies-list nil)
+ (nnoo-close-server 'nnoo)
+ t)
+
+(deffoo nnsoup-request-article (id &optional newsgroup server buffer)
+ (nnsoup-possibly-change-group newsgroup)
+ (let (buf)
+ (save-excursion
+ (set-buffer (or buffer nntp-server-buffer))
+ (erase-buffer)
+ (when (and (not (stringp id))
+ (setq buf (nnsoup-narrow-to-article id)))
+ (insert-buffer-substring buf)
+ t))))
+
+(deffoo nnsoup-request-group (group &optional server dont-check)
+ (nnsoup-possibly-change-group group)
+ (if dont-check
+ t
+ (let ((active (cadr (assoc group nnsoup-group-alist))))
+ (if (not active)
+ (nnheader-report 'nnsoup "No such group: %s" group)
+ (nnheader-insert
+ "211 %d %d %d %s\n"
+ (max (1+ (- (cdr active) (car active))) 0)
+ (car active) (cdr active) group)))))
+
+(deffoo nnsoup-request-type (group &optional article)
+ (nnsoup-possibly-change-group group)
+ ;; Try to guess the type based on the first article in the group.
+ (when (not article)
+ (setq article
+ (cdaar (cddr (assoc group nnsoup-group-alist)))))
+ (if (not article)
+ 'unknown
+ (let ((kind (gnus-soup-encoding-kind
+ (gnus-soup-area-encoding
+ (nth 1 (nnsoup-article-to-area
+ article nnsoup-current-group))))))
+ (cond ((= kind ?m) 'mail)
+ ((= kind ?n) 'news)
+ (t 'unknown)))))
+
+(deffoo nnsoup-close-group (group &optional server)
+ ;; Kill all nnsoup buffers.
+ (let ((buffers nnsoup-buffers)
+ elem)
+ (while buffers
+ (when (equal (car (setq elem (pop buffers))) group)
+ (setq nnsoup-buffers (delq elem nnsoup-buffers))
+ (and (cdr elem) (buffer-name (cdr elem))
+ (kill-buffer (cdr elem))))))
+ t)
+
+(deffoo nnsoup-request-list (&optional server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (unless nnsoup-group-alist
+ (nnsoup-read-active-file))
+ (let ((alist nnsoup-group-alist)
+ (standard-output (current-buffer))
+ entry)
+ (while (setq entry (pop alist))
+ (insert (car entry) " ")
+ (princ (cdadr entry))
+ (insert " ")
+ (princ (caadr entry))
+ (insert " y\n"))
+ t)))
+
+(deffoo nnsoup-request-scan (group &optional server)
+ (nnsoup-unpack-packets))
+
+(deffoo nnsoup-request-newgroups (date &optional server)
+ (nnsoup-request-list))
+
+(deffoo nnsoup-request-list-newsgroups (&optional server)
+ nil)
+
+(deffoo nnsoup-request-post (&optional server)
+ (nnsoup-store-reply "news")
+ t)
+
+(deffoo nnsoup-request-mail (&optional server)
+ (nnsoup-store-reply "mail")
+ t)
+
+(deffoo nnsoup-request-expire-articles (articles group &optional server force)
+ (nnsoup-possibly-change-group group)
+ (let* ((total-infolist (assoc group nnsoup-group-alist))
+ (active (cadr total-infolist))
+ (infolist (cddr total-infolist))
+ info range-list mod-time prefix)
+ (while infolist
+ (setq info (pop infolist)
+ range-list (gnus-uncompress-range (car info))
+ prefix (gnus-soup-area-prefix (nth 1 info)))
+ (when ;; All the articles in this file are marked for expiry.
+ (and (or (setq mod-time (nth 5 (file-attributes
+ (nnsoup-file prefix))))
+ (setq mod-time (nth 5 (file-attributes
+ (nnsoup-file prefix t)))))
+ (gnus-sublist-p articles range-list)
+ ;; This file is old enough.
+ (nnmail-expired-article-p group mod-time force))
+ ;; Ok, we delete this file.
+ (when (ignore-errors
+ (nnheader-message
+ 5 "Deleting %s in group %s..." (nnsoup-file prefix)
+ group)
+ (when (file-exists-p (nnsoup-file prefix))
+ (delete-file (nnsoup-file prefix)))
+ (nnheader-message
+ 5 "Deleting %s in group %s..." (nnsoup-file prefix t)
+ group)
+ (when (file-exists-p (nnsoup-file prefix t))
+ (delete-file (nnsoup-file prefix t)))
+ t)
+ (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
+ (setq articles (gnus-sorted-complement articles range-list))))
+ (when (not mod-time)
+ (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
+ (if (cddr total-infolist)
+ (setcar active (caaadr (cdr total-infolist)))
+ (setcar active (1+ (cdr active))))
+ (nnsoup-write-active-file t)
+ ;; Return the articles that weren't expired.
+ articles))
+
+\f
+;;; Internal functions
+
+(defun nnsoup-possibly-change-group (group &optional force)
+ (when (and group
+ (not (equal nnsoup-current-group group)))
+ (setq nnsoup-article-alist nil)
+ (setq nnsoup-current-group group))
+ t)
+
+(defun nnsoup-read-active-file ()
+ (setq nnsoup-group-alist nil)
+ (when (file-exists-p nnsoup-active-file)
+ (ignore-errors
+ (load nnsoup-active-file t t t))
+ ;; Be backwards compatible.
+ (when (and nnsoup-group-alist
+ (not (atom (caadar nnsoup-group-alist))))
+ (let ((alist nnsoup-group-alist)
+ entry e min max)
+ (while (setq e (cdr (setq entry (pop alist))))
+ (setq min (caaar e))
+ (while (cdr e)
+ (setq e (cdr e)))
+ (setq max (cdaar e))
+ (setcdr entry (cons (cons min max) (cdr entry)))))
+ (setq nnsoup-group-alist-touched t))
+ nnsoup-group-alist))
+
+(defun nnsoup-write-active-file (&optional force)
+ (when (and nnsoup-group-alist
+ (or force
+ nnsoup-group-alist-touched))
+ (setq nnsoup-group-alist-touched nil)
+ (nnheader-temp-write nnsoup-active-file
+ (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
+ (insert "\n")
+ (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
+ (insert "\n"))))
+
+(defun nnsoup-next-prefix ()
+ "Return the next free prefix."
+ (let (prefix)
+ (while (or (file-exists-p
+ (nnsoup-file (setq prefix (int-to-string
+ nnsoup-current-prefix))))
+ (file-exists-p (nnsoup-file prefix t)))
+ (incf nnsoup-current-prefix))
+ (incf nnsoup-current-prefix)
+ prefix))
+
+(defun nnsoup-file-name (dir file)
+ "Return the full path of FILE (in any case) in DIR."
+ (let* ((case-fold-search t)
+ (files (directory-files dir t))
+ (regexp (concat (regexp-quote file) "$")))
+ (car (delq nil
+ (mapcar
+ (lambda (file)
+ (if (string-match regexp file)
+ file
+ nil))
+ files)))))
+
+(defun nnsoup-read-areas ()
+ (let ((areas-file (nnsoup-file-name nnsoup-tmp-directory "areas")))
+ (when areas-file
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let ((areas (gnus-soup-parse-areas areas-file))
+ entry number area lnum cur-prefix file)
+ ;; Go through all areas in the new AREAS file.
+ (while (setq area (pop areas))
+ ;; Change the name to the permanent name and move the files.
+ (setq cur-prefix (nnsoup-next-prefix))
+ (message "Incorporating file %s..." cur-prefix)
+ (when (file-exists-p
+ (setq file (concat nnsoup-tmp-directory
+ (gnus-soup-area-prefix area) ".IDX")))
+ (rename-file file (nnsoup-file cur-prefix)))
+ (when (file-exists-p
+ (setq file (concat nnsoup-tmp-directory
+ (gnus-soup-area-prefix area) ".MSG")))
+ (rename-file file (nnsoup-file cur-prefix t))
+ (gnus-soup-set-area-prefix area cur-prefix)
+ ;; Find the number of new articles in this area.
+ (setq number (nnsoup-number-of-articles area))
+ (if (not (setq entry (assoc (gnus-soup-area-name area)
+ nnsoup-group-alist)))
+ ;; If this is a new area (group), we just add this info to
+ ;; the group alist.
+ (push (list (gnus-soup-area-name area)
+ (cons 1 number)
+ (list (cons 1 number) area))
+ nnsoup-group-alist)
+ ;; There are already articles in this group, so we add this
+ ;; info to the end of the entry.
+ (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry)))
+ (+ lnum number))
+ area)))
+ (setcdr (cadr entry) (+ lnum number))))))
+ (nnsoup-write-active-file t)
+ (delete-file areas-file)))))
+
+(defun nnsoup-number-of-articles (area)
+ (save-excursion
+ (cond
+ ;; If the number is in the area info, we just return it.
+ ((gnus-soup-area-number area)
+ (gnus-soup-area-number area))
+ ;; If there is an index file, we just count the lines.
+ ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n)
+ (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
+ (count-lines (point-min) (point-max)))
+ ;; We do it the hard way - re-searching through the message
+ ;; buffer.
+ (t
+ (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
+ (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist)
+ (nnsoup-dissect-buffer area))
+ (length (cdr (assoc (gnus-soup-area-prefix area)
+ nnsoup-article-alist)))))))
+
+(defun nnsoup-dissect-buffer (area)
+ (let ((mbox-delim (concat "^" message-unix-mail-delimiter))
+ (format (gnus-soup-encoding-format (gnus-soup-area-encoding area)))
+ (i 0)
+ alist len)
+ (goto-char (point-min))
+ (cond
+ ;; rnews batch format
+ ((= format ?n)
+ (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$")
+ (forward-line 1)
+ (push (list
+ (incf i) (point)
+ (progn
+ (forward-char (string-to-number (match-string 1)))
+ (point)))
+ alist)))
+ ;; Unix mbox format
+ ((= format ?m)
+ (while (looking-at mbox-delim)
+ (forward-line 1)
+ (push (list
+ (incf i) (point)
+ (progn
+ (if (re-search-forward mbox-delim nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))
+ (point)))
+ alist)))
+ ;; MMDF format
+ ((= format ?M)
+ (while (looking-at "\^A\^A\^A\^A\n")
+ (forward-line 1)
+ (push (list
+ (incf i) (point)
+ (progn
+ (if (search-forward "\n\^A\^A\^A\^A\n" nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))
+ (point)))
+ alist)))
+ ;; Binary format
+ ((or (= format ?B) (= format ?b))
+ (while (not (eobp))
+ (setq len (+ (* (char-after (point)) (expt 2.0 24))
+ (* (char-after (+ (point) 1)) (expt 2 16))
+ (* (char-after (+ (point) 2)) (expt 2 8))
+ (char-after (+ (point) 3))))
+ (push (list
+ (incf i) (+ (point) 4)
+ (progn
+ (forward-char (floor (+ len 4)))
+ (point)))
+ alist)))
+ (t
+ (error "Unknown format: %c" format)))
+ (push (cons (gnus-soup-area-prefix area) alist) nnsoup-article-alist)))
+
+(defun nnsoup-index-buffer (prefix &optional message)
+ (let* ((file (concat prefix (if message ".MSG" ".IDX")))
+ (buffer-name (concat " *nnsoup " file "*")))
+ (or (get-buffer buffer-name) ; File already loaded.
+ (when (file-exists-p (concat nnsoup-directory file))
+ (save-excursion ; Load the file.
+ (set-buffer (get-buffer-create buffer-name))
+ (buffer-disable-undo (current-buffer))
+ (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
+ (nnheader-insert-file-contents (concat nnsoup-directory file))
+ (current-buffer))))))
+
+(defun nnsoup-file (prefix &optional message)
+ (expand-file-name
+ (concat nnsoup-directory prefix (if message ".MSG" ".IDX"))))
+
+(defun nnsoup-message-buffer (prefix)
+ (nnsoup-index-buffer prefix 'msg))
+
+(defun nnsoup-unpack-packets ()
+ "Unpack all packets in `nnsoup-packet-directory'."
+ (let ((packets (directory-files
+ nnsoup-packet-directory t nnsoup-packet-regexp))
+ packet)
+ (while (setq packet (pop packets))
+ (message "nnsoup: unpacking %s..." packet)
+ (if (not (gnus-soup-unpack-packet
+ nnsoup-tmp-directory nnsoup-unpacker packet))
+ (message "Couldn't unpack %s" packet)
+ (delete-file packet)
+ (nnsoup-read-areas)
+ (message "Unpacking...done")))))
+
+(defun nnsoup-narrow-to-article (article &optional area head)
+ (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
+ (prefix (and area (gnus-soup-area-prefix (nth 1 area))))
+ (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg)))
+ beg end)
+ (when area
+ (save-excursion
+ (cond
+ ;; There is no MSG file.
+ ((null msg-buf)
+ nil)
+ ;; We use the index file to find out where the article
+ ;; begins and ends.
+ ((and (= (gnus-soup-encoding-index
+ (gnus-soup-area-encoding (nth 1 area)))
+ ?c)
+ (file-exists-p (nnsoup-file prefix)))
+ (set-buffer (nnsoup-index-buffer prefix))
+ (widen)
+ (goto-char (point-min))
+ (forward-line (- article (caar area)))
+ (setq beg (read (current-buffer)))
+ (forward-line 1)
+ (if (looking-at "[0-9]+")
+ (progn
+ (setq end (read (current-buffer)))
+ (set-buffer msg-buf)
+ (widen)
+ (let ((format (gnus-soup-encoding-format
+ (gnus-soup-area-encoding (nth 1 area)))))
+ (goto-char end)
+ (when (or (= format ?n) (= format ?m))
+ (setq end (progn (forward-line -1) (point))))))
+ (set-buffer msg-buf))
+ (widen)
+ (narrow-to-region beg (or end (point-max))))
+ (t
+ (set-buffer msg-buf)
+ (widen)
+ (unless (assoc (gnus-soup-area-prefix (nth 1 area))
+ nnsoup-article-alist)
+ (nnsoup-dissect-buffer (nth 1 area)))
+ (let ((entry (assq article (cdr (assoc (gnus-soup-area-prefix
+ (nth 1 area))
+ nnsoup-article-alist)))))
+ (when entry
+ (narrow-to-region (cadr entry) (caddr entry))))))
+ (goto-char (point-min))
+ (if (not head)
+ ()
+ (narrow-to-region
+ (point-min)
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max))))
+ msg-buf))))
+
+;;;###autoload
+(defun nnsoup-pack-replies ()
+ "Make an outbound package of SOUP replies."
+ (interactive)
+ (unless (file-exists-p nnsoup-replies-directory)
+ (message "No such directory: %s" nnsoup-replies-directory))
+ ;; Write all data buffers.
+ (gnus-soup-save-areas)
+ ;; Write the active file.
+ (nnsoup-write-active-file)
+ ;; Write the REPLIES file.
+ (nnsoup-write-replies)
+ ;; Check whether there is anything here.
+ (when (null (directory-files nnsoup-replies-directory nil "\\.MSG$"))
+ (error "No files to pack"))
+ ;; Pack all these files into a SOUP packet.
+ (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
+
+(defun nnsoup-write-replies ()
+ "Write the REPLIES file."
+ (when nnsoup-replies-list
+ (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)
+ (setq nnsoup-replies-list nil)))
+
+(defun nnsoup-article-to-area (article group)
+ "Return the area that ARTICLE in GROUP is located in."
+ (let ((areas (cddr (assoc group nnsoup-group-alist))))
+ (while (and areas (< (cdaar areas) article))
+ (setq areas (cdr areas)))
+ (and areas (car areas))))
+
+(defvar nnsoup-old-functions
+ (list message-send-mail-function message-send-news-function))
+
+;;;###autoload
+(defun nnsoup-set-variables ()
+ "Use the SOUP methods for posting news and mailing mail."
+ (interactive)
+ (setq message-send-news-function 'nnsoup-request-post)
+ (setq message-send-mail-function 'nnsoup-request-mail))
+
+;;;###autoload
+(defun nnsoup-revert-variables ()
+ "Revert posting and mailing methods to the standard Emacs methods."
+ (interactive)
+ (setq message-send-mail-function (car nnsoup-old-functions))
+ (setq message-send-news-function (cadr nnsoup-old-functions)))
+
+(defun nnsoup-store-reply (kind)
+ ;; Mostly stolen from `message.el'.
+ (require 'mail-utils)
+ (let ((tembuf (generate-new-buffer " message temp"))
+ (case-fold-search nil)
+ delimline
+ (mailbuf (current-buffer)))
+ (unwind-protect
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (if (equal kind "mail")
+ (message-generate-headers message-required-mail-headers)
+ (message-generate-headers message-required-news-headers)))
+ (set-buffer tembuf)
+ (erase-buffer)
+ (insert-buffer-substring mailbuf)
+ ;; Remove some headers.
+ (save-restriction
+ (message-narrow-to-headers)
+ ;; Remove some headers.
+ (message-remove-header message-ignored-mail-headers t))
+ (goto-char (point-max))
+ ;; require one newline at the end.
+ (or (= (preceding-char) ?\n)
+ (insert ?\n))
+ (let ((case-fold-search t))
+ ;; Change header-delimiter to be what sendmail expects.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (backward-char 1)
+ (setq delimline (point-marker))
+ ;; Insert an extra newline if we need it to work around
+ ;; Sun's bug that swallows newlines.
+ (goto-char (1+ delimline))
+ (when (eval message-mailer-swallows-blank-line)
+ (newline))
+ (let ((msg-buf
+ (gnus-soup-store
+ nnsoup-replies-directory
+ (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
+ nnsoup-replies-index-type))
+ (num 0))
+ (when (and msg-buf (bufferp msg-buf))
+ (save-excursion
+ (set-buffer msg-buf)
+ (goto-char (point-min))
+ (while (re-search-forward "^#! *rnews" nil t)
+ (incf num))
+ (when nnsoup-always-save
+ (save-buffer)))
+ (message "Stored %d messages" num)))
+ (nnsoup-write-replies)
+ (kill-buffer tembuf))))))
+
+(defun nnsoup-kind-to-prefix (kind)
+ (unless nnsoup-replies-list
+ (setq nnsoup-replies-list
+ (gnus-soup-parse-replies
+ (concat nnsoup-replies-directory "REPLIES"))))
+ (let ((replies nnsoup-replies-list))
+ (while (and replies
+ (not (string= kind (gnus-soup-reply-kind (car replies)))))
+ (setq replies (cdr replies)))
+ (if replies
+ (gnus-soup-reply-prefix (car replies))
+ (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
+ kind
+ (format "%c%c%c"
+ nnsoup-replies-format-type
+ nnsoup-replies-index-type
+ (if (string= kind "news")
+ ?n ?m)))
+ nnsoup-replies-list)
+ (gnus-soup-reply-prefix (car nnsoup-replies-list)))))
+
+(defun nnsoup-make-active ()
+ "(Re-)create the SOUP active file."
+ (interactive)
+ (let ((files (sort (directory-files nnsoup-directory t "IDX$")
+ (lambda (f1 f2)
+ (< (progn (string-match "/\\([0-9]+\\)\\." f1)
+ (string-to-int (match-string 1 f1)))
+ (progn (string-match "/\\([0-9]+\\)\\." f2)
+ (string-to-int (match-string 1 f2)))))))
+ active group lines ident elem min)
+ (set-buffer (get-buffer-create " *nnsoup work*"))
+ (buffer-disable-undo (current-buffer))
+ (while files
+ (message "Doing %s..." (car files))
+ (erase-buffer)
+ (nnheader-insert-file-contents (car files))
+ (goto-char (point-min))
+ (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
+ (setq group "unknown")
+ (setq group (match-string 2)))
+ (setq lines (count-lines (point-min) (point-max)))
+ (setq ident (progn (string-match
+ "/\\([0-9]+\\)\\." (car files))
+ (substring
+ (car files) (match-beginning 1)
+ (match-end 1))))
+ (if (not (setq elem (assoc group active)))
+ (push (list group (cons 1 lines)
+ (list (cons 1 lines)
+ (vector ident group "ncm" "" lines)))
+ active)
+ (nconc elem
+ (list
+ (list (cons (1+ (setq min (cdadr elem)))
+ (+ min lines))
+ (vector ident group "ncm" "" lines))))
+ (setcdr (cadr elem) (+ min lines)))
+ (setq files (cdr files)))
+ (message "")
+ (setq nnsoup-group-alist active)
+ (nnsoup-write-active-file t)))
+
+(defun nnsoup-delete-unreferenced-message-files ()
+ "Delete any *.MSG and *.IDX files that aren't known by nnsoup."
+ (interactive)
+ (let* ((known (apply 'nconc (mapcar
+ (lambda (ga)
+ (mapcar
+ (lambda (area)
+ (gnus-soup-area-prefix (cadr area)))
+ (cddr ga)))
+ nnsoup-group-alist)))
+ (regexp "\\.MSG$\\|\\.IDX$")
+ (files (directory-files nnsoup-directory nil regexp))
+ non-files file)
+ ;; Find all files that aren't known by nnsoup.
+ (while (setq file (pop files))
+ (string-match regexp file)
+ (unless (member (substring file 0 (match-beginning 0)) known)
+ (push file non-files)))
+ ;; Sort and delete the files.
+ (setq non-files (sort non-files 'string<))
+ (map-y-or-n-p "Delete file %s? "
+ (lambda (file) (delete-file (concat nnsoup-directory file)))
+ non-files)))
+
+(provide 'nnsoup)
+
+;;; nnsoup.el ends here
--- /dev/null
+;;; nnspool.el --- spool access for GNU Emacs
+;; Copyright (C) 1988,89,90,93,94,95,96,97 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nntp)
+(require 'timezone)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nnspool)
+
+(defvoo nnspool-inews-program news-inews-program
+ "Program to post news.
+This is most commonly `inews' or `injnews'.")
+
+(defvoo nnspool-inews-switches '("-h" "-S")
+ "Switches for nnspool-request-post to pass to `inews' for posting news.
+If you are using Cnews, you probably should set this variable to nil.")
+
+(defvoo nnspool-spool-directory (file-name-as-directory news-path)
+ "Local news spool directory.")
+
+(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/")
+ "Local news nov directory.")
+
+(defvoo nnspool-lib-dir "/usr/lib/news/"
+ "Where the local news library files are stored.")
+
+(defvoo nnspool-active-file (concat nnspool-lib-dir "active")
+ "Local news active file.")
+
+(defvoo nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups")
+ "Local news newsgroups file.")
+
+(defvoo nnspool-distributions-file (concat nnspool-lib-dir "distribs.pat")
+ "Local news distributions file.")
+
+(defvoo nnspool-history-file (concat nnspool-lib-dir "history")
+ "Local news history file.")
+
+(defvoo nnspool-active-times-file (concat nnspool-lib-dir "active.times")
+ "Local news active date file.")
+
+(defvoo nnspool-large-newsgroup 50
+ "The number of the articles which indicates a large newsgroup.
+If the number of the articles is greater than the value, verbose
+messages will be shown to indicate the current status.")
+
+(defvoo nnspool-nov-is-evil nil
+ "Non-nil means that nnspool will never return NOV lines instead of headers.")
+
+(defconst nnspool-sift-nov-with-sed nil
+ "If non-nil, use sed to get the relevant portion from the overview file.
+If nil, nnspool will load the entire file into a buffer and process it
+there.")
+
+(defvoo nnspool-rejected-article-hook nil
+ "*A hook that will be run when an article has been rejected by the server.")
+
+;; 1997/8/14 by MORIOKA Tomohiko
+(defvoo nnspool-file-coding-system nnheader-file-coding-system
+ "Coding system for nnspool.")
+
+\f
+
+(defconst nnspool-version "nnspool 2.0"
+ "Version numbers of this version of NNSPOOL.")
+
+(defvoo nnspool-current-directory nil
+ "Current news group directory.")
+
+(defvoo nnspool-current-group nil)
+(defvoo nnspool-status-string "")
+
+\f
+;;; Interface functions.
+
+(nnoo-define-basics nnspool)
+
+(deffoo nnspool-retrieve-headers (articles &optional group server fetch-old)
+ "Retrieve the headers of ARTICLES."
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (when (nnspool-possibly-change-directory group)
+ (let* ((number (length articles))
+ (count 0)
+ (default-directory nnspool-current-directory)
+ (do-message (and (numberp nnspool-large-newsgroup)
+ (> number nnspool-large-newsgroup)))
+ (nnheader-file-coding-system nnspool-file-coding-system)
+ file beg article ag)
+ (if (and (numberp (car articles))
+ (nnspool-retrieve-headers-with-nov articles fetch-old))
+ ;; We successfully retrieved the NOV headers.
+ 'nov
+ ;; No NOV headers here, so we do it the hard way.
+ (while (setq article (pop articles))
+ (if (stringp article)
+ ;; This is a Message-ID.
+ (setq ag (nnspool-find-id article)
+ file (and ag (nnspool-article-pathname
+ (car ag) (cdr ag)))
+ article (cdr ag))
+ ;; This is an article in the current group.
+ (setq file (int-to-string article)))
+ ;; Insert the head of the article.
+ (when (and file
+ (file-exists-p file))
+ (insert "221 ")
+ (princ article (current-buffer))
+ (insert " Article retrieved.\n")
+ (setq beg (point))
+ (inline (nnheader-insert-head file))
+ (goto-char beg)
+ (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (insert ".\n")
+ (delete-region (point) (point-max)))
+
+ (and do-message
+ (zerop (% (incf count) 20))
+ (message "nnspool: Receiving headers... %d%%"
+ (/ (* count 100) number))))
+
+ (when do-message
+ (message "nnspool: Receiving headers...done"))
+
+ ;; Fold continuation lines.
+ (nnheader-fold-continuation-lines)
+ 'headers)))))
+
+(deffoo nnspool-open-server (server &optional defs)
+ (nnoo-change-server 'nnspool server defs)
+ (cond
+ ((not (file-exists-p nnspool-spool-directory))
+ (nnspool-close-server)
+ (nnheader-report 'nnspool "Spool directory doesn't exist: %s"
+ nnspool-spool-directory))
+ ((not (file-directory-p
+ (directory-file-name
+ (file-truename nnspool-spool-directory))))
+ (nnspool-close-server)
+ (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory))
+ ((not (file-exists-p nnspool-active-file))
+ (nnheader-report 'nnspool "The active file doesn't exist: %s"
+ nnspool-active-file))
+ (t
+ (nnheader-report 'nnspool "Opened server %s using directory %s"
+ server nnspool-spool-directory)
+ t)))
+
+(deffoo nnspool-request-article (id &optional group server buffer)
+ "Select article by message ID (or number)."
+ (nnspool-possibly-change-directory group)
+ (let ((nntp-server-buffer (or buffer nntp-server-buffer))
+ file ag)
+ (if (stringp id)
+ ;; This is a Message-ID.
+ (when (setq ag (nnspool-find-id id))
+ (setq file (nnspool-article-pathname (car ag) (cdr ag))))
+ (setq file (nnspool-article-pathname nnspool-current-group id)))
+ (and file
+ (file-exists-p file)
+ (not (file-directory-p file))
+ (save-excursion (nnspool-find-file file))
+ ;; We return the article number and group name.
+ (if (numberp id)
+ (cons nnspool-current-group id)
+ ag))))
+
+(deffoo nnspool-request-body (id &optional group server)
+ "Select article body by message ID (or number)."
+ (nnspool-possibly-change-directory group)
+ (let ((res (nnspool-request-article id)))
+ (when res
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (point-min) (point)))
+ res))))
+
+(deffoo nnspool-request-head (id &optional group server)
+ "Select article head by message ID (or number)."
+ (nnspool-possibly-change-directory group)
+ (let ((res (nnspool-request-article id)))
+ (when res
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (1- (point)) (point-max)))
+ (nnheader-fold-continuation-lines)))
+ res))
+
+(deffoo nnspool-request-group (group &optional server dont-check)
+ "Select news GROUP."
+ (let ((pathname (nnspool-article-pathname group))
+ dir)
+ (if (not (file-directory-p pathname))
+ (nnheader-report
+ 'nnspool "Invalid group name (no such directory): %s" group)
+ (setq nnspool-current-directory pathname)
+ (nnheader-report 'nnspool "Selected group %s" group)
+ (if dont-check
+ (progn
+ (nnheader-report 'nnspool "Selected group %s" group)
+ t)
+ ;; Yes, completely empty spool directories *are* possible.
+ ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
+ (when (setq dir (directory-files pathname nil "^[0-9]+$" t))
+ (setq dir
+ (sort (mapcar (lambda (name) (string-to-int name)) dir) '<)))
+ (if dir
+ (nnheader-insert
+ "211 %d %d %d %s\n" (length dir) (car dir)
+ (progn (while (cdr dir) (setq dir (cdr dir))) (car dir))
+ group)
+ (nnheader-report 'nnspool "Empty group %s" group)
+ (nnheader-insert "211 0 0 0 %s\n" group))))))
+
+(deffoo nnspool-request-type (group &optional article)
+ 'news)
+
+(deffoo nnspool-close-group (group &optional server)
+ t)
+
+(deffoo nnspool-request-list (&optional server)
+ "List active newsgroups."
+ (save-excursion
+ (or (nnspool-find-file nnspool-active-file)
+ (nnheader-report 'nnspool (nnheader-file-error nnspool-active-file)))))
+
+(deffoo nnspool-request-list-newsgroups (&optional server)
+ "List newsgroups (defined in NNTP2)."
+ (save-excursion
+ (or (nnspool-find-file nnspool-newsgroups-file)
+ (nnheader-report 'nnspool (nnheader-file-error
+ nnspool-newsgroups-file)))))
+
+(deffoo nnspool-request-list-distributions (&optional server)
+ "List distributions (defined in NNTP2)."
+ (save-excursion
+ (or (nnspool-find-file nnspool-distributions-file)
+ (nnheader-report 'nnspool (nnheader-file-error
+ nnspool-distributions-file)))))
+
+;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
+(deffoo nnspool-request-newgroups (date &optional server)
+ "List groups created after DATE."
+ (if (nnspool-find-file nnspool-active-times-file)
+ (save-excursion
+ ;; Find the last valid line.
+ (goto-char (point-max))
+ (while (and (not (looking-at
+ "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] "))
+ (zerop (forward-line -1))))
+ (let ((seconds (nnspool-seconds-since-epoch date))
+ groups)
+ ;; Go through lines and add the latest groups to a list.
+ (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ")
+ (progn
+ ;; We insert a .0 to make the list reader
+ ;; interpret the number as a float. It is far
+ ;; too big to be stored in a lisp integer.
+ (goto-char (1- (match-end 0)))
+ (insert ".0")
+ (> (progn
+ (goto-char (match-end 1))
+ (read (current-buffer)))
+ seconds))
+ (push (buffer-substring
+ (match-beginning 1) (match-end 1))
+ groups)
+ (zerop (forward-line -1))))
+ (erase-buffer)
+ (while groups
+ (insert (car groups) " 0 0 y\n")
+ (setq groups (cdr groups))))
+ t)
+ nil))
+
+(deffoo nnspool-request-post (&optional server)
+ "Post a new news in current buffer."
+ (save-excursion
+ (let* ((process-connection-type nil) ; t bugs out on Solaris
+ (inews-buffer (generate-new-buffer " *nnspool post*"))
+ (proc
+ (condition-case err
+ (apply 'start-process "*nnspool inews*" inews-buffer
+ nnspool-inews-program nnspool-inews-switches)
+ (error
+ (nnheader-report 'nnspool "inews error: %S" err)))))
+ (if (not proc)
+ ;; The inews program failed.
+ ()
+ (nnheader-report 'nnspool "")
+ (set-process-sentinel proc 'nnspool-inews-sentinel)
+ (process-send-region proc (point-min) (point-max))
+ ;; We slap a condition-case around this, because the process may
+ ;; have exited already...
+ (ignore-errors
+ (process-send-eof proc))
+ t))))
+
+
+\f
+;;; Internal functions.
+
+(defun nnspool-inews-sentinel (proc status)
+ (save-excursion
+ (set-buffer (process-buffer proc))
+ (goto-char (point-min))
+ (if (or (zerop (buffer-size))
+ (search-forward "spooled" nil t))
+ (kill-buffer (current-buffer))
+ ;; Make status message by folding lines.
+ (while (re-search-forward "[ \t\n]+" nil t)
+ (replace-match " " t t))
+ (nnheader-report 'nnspool "%s" (buffer-string))
+ (message "nnspool: %s" nnspool-status-string)
+ (ding)
+ (run-hooks 'nnspool-rejected-article-hook))))
+
+(defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old)
+ (if (or gnus-nov-is-evil nnspool-nov-is-evil)
+ nil
+ (let ((nov (nnheader-group-pathname
+ nnspool-current-group nnspool-nov-directory ".overview"))
+ (arts articles)
+ (nnheader-file-coding-system nnspool-file-coding-system)
+ last)
+ (if (not (file-exists-p nov))
+ ()
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (if nnspool-sift-nov-with-sed
+ (nnspool-sift-nov-with-sed articles nov)
+ (nnheader-insert-file-contents nov)
+ (if (and fetch-old
+ (not (numberp fetch-old)))
+ t ; We want all the headers.
+ (ignore-errors
+ ;; Delete unwanted NOV lines.
+ (nnheader-nov-delete-outside-range
+ (if fetch-old (max 1 (- (car articles) fetch-old))
+ (car articles))
+ (car (last articles)))
+ ;; If the buffer is empty, this wasn't very successful.
+ (unless (zerop (buffer-size))
+ ;; We check what the last article number was.
+ ;; The NOV file may be out of sync with the articles
+ ;; in the group.
+ (forward-line -1)
+ (setq last (read (current-buffer)))
+ (if (= last (car articles))
+ ;; Yup, it's all there.
+ t
+ ;; Perhaps not. We try to find the missing articles.
+ (while (and arts
+ (<= last (car arts)))
+ (pop arts))
+ ;; The articles in `arts' are missing from the buffer.
+ (while arts
+ (nnspool-insert-nov-head (pop arts)))
+ t))))))))))
+
+(defun nnspool-insert-nov-head (article)
+ "Read the head of ARTICLE, convert to NOV headers, and insert."
+ (save-excursion
+ (let ((cur (current-buffer))
+ buf)
+ (setq buf (nnheader-set-temp-buffer " *nnspool head*"))
+ (when (nnheader-insert-head
+ (nnspool-article-pathname nnspool-current-group article))
+ (nnheader-insert-article-line article)
+ (let ((headers (nnheader-parse-head)))
+ (set-buffer cur)
+ (goto-char (point-max))
+ (nnheader-insert-nov headers)))
+ (kill-buffer buf))))
+
+(defun nnspool-sift-nov-with-sed (articles file)
+ (let ((first (car articles))
+ (last (progn (while (cdr articles) (setq articles (cdr articles)))
+ (car articles))))
+ (call-process "awk" nil t nil
+ (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}"
+ (1- first) (1+ last))
+ file)))
+
+;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle).
+;; Find out what group an article identified by a Message-ID is in.
+(defun nnspool-find-id (id)
+ (save-excursion
+ (set-buffer (get-buffer-create " *nnspool work*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (ignore-errors
+ (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file))
+ (goto-char (point-min))
+ (prog1
+ (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]")
+ (cons (match-string 1) (string-to-int (match-string 2))))
+ (kill-buffer (current-buffer)))))
+
+(defun nnspool-find-file (file)
+ "Insert FILE in server buffer safely."
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (condition-case ()
+ (let ((nnheader-file-coding-system nnspool-file-coding-system))
+ (nnheader-insert-file-contents file)
+ t)
+ (file-error nil)))
+
+(defun nnspool-possibly-change-directory (group)
+ (if (not group)
+ t
+ (let ((pathname (nnspool-article-pathname group)))
+ (if (file-directory-p pathname)
+ (setq nnspool-current-directory pathname
+ nnspool-current-group group)
+ (nnheader-report 'nnspool "No such newsgroup: %s" group)))))
+
+(defun nnspool-article-pathname (group &optional article)
+ "Find the path for GROUP."
+ (nnheader-group-pathname group nnspool-spool-directory article))
+
+(defun nnspool-seconds-since-epoch (date)
+ (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti)))
+ (timezone-parse-date date)))
+ (ttime (mapcar (lambda (ti) (and ti (string-to-int ti)))
+ (timezone-parse-time
+ (aref (timezone-parse-date date) 3))))
+ (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime)
+ (nth 2 tdate) (nth 1 tdate) (nth 0 tdate)
+ (nth 4 tdate))))
+ (+ (* (car unix) 65536.0)
+ (cadr unix))))
+
+(provide 'nnspool)
+
+;;; nnspool.el ends here
--- /dev/null
+;;; nntp.el --- nntp access for Gnus
+;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnoo)
+(require 'gnus-util)
+
+(nnoo-declare nntp)
+
+(eval-and-compile
+ (unless (fboundp 'open-network-stream)
+ (require 'tcp)))
+
+(eval-when-compile (require 'cl))
+
+(defvoo nntp-address nil
+ "Address of the physical nntp server.")
+
+(defvoo nntp-port-number "nntp"
+ "Port number on the physical nntp server.")
+
+(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
+ "*Hook used for sending commands to the server at startup.
+The default value is `nntp-send-mode-reader', which makes an innd
+server spawn an nnrpd server. Another useful function to put in this
+hook might be `nntp-send-authinfo', which will prompt for a password
+to allow posting from the server. Note that this is only necessary to
+do on servers that use strict access control.")
+
+(defvoo nntp-authinfo-function 'nntp-send-authinfo
+ "Function used to send AUTHINFO to the server.")
+
+(defvoo nntp-server-action-alist
+ '(("nntpd 1\\.5\\.11t"
+ (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))
+ ("NNRP server Netscape"
+ (setq nntp-server-list-active-group nil)))
+ "Alist of regexps to match on server types and actions to be taken.
+For instance, if you want Gnus to beep every time you connect
+to innd, you could say something like:
+
+\(setq nntp-server-action-alist
+ '((\"innd\" (ding))))
+
+You probably don't want to do that, though.")
+
+(defvoo nntp-open-connection-function 'nntp-open-network-stream
+ "*Function used for connecting to a remote system.
+It will be called with the buffer to output in.
+
+Two pre-made functions are `nntp-open-network-stream', which is the
+default, and simply connects to some port or other on the remote
+system (see nntp-port-number). The other are `nntp-open-rlogin',
+which does an rlogin on the remote system, and then does a telnet to
+the NNTP server available there (see nntp-rlogin-parameters) and
+`nntp-open-telnet' which telnets to a remote system, logs in and does
+the same.")
+
+(defvoo nntp-rlogin-program "rsh"
+ "*Program used to log in on remote machines.
+The default is \"rsh\", but \"ssh\" is a popular alternative.")
+
+(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
+ "*Parameters to `nntp-open-login'.
+That function may be used as `nntp-open-connection-function'. In that
+case, this list will be used as the parameter list given to rsh.")
+
+(defvoo nntp-rlogin-user-name nil
+ "*User name on remote system when using the rlogin connect method.")
+
+(defvoo nntp-telnet-parameters '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")
+ "*Parameters to `nntp-open-telnet'.
+That function may be used as `nntp-open-connection-function'. In that
+case, this list will be executed as a command after logging in
+via telnet.")
+
+(defvoo nntp-telnet-user-name nil
+ "User name to log in via telnet with.")
+
+(defvoo nntp-telnet-passwd nil
+ "Password to use to log in via telnet with.")
+
+(defvoo nntp-telnet-command "telnet"
+ "Command used to start telnet.")
+
+(defvoo nntp-telnet-switches '("-8")
+ "Switches given to the telnet command.")
+
+(defvoo nntp-end-of-line "\r\n"
+ "String to use on the end of lines when talking to the NNTP server.
+This is \"\\r\\n\" by default, but should be \"\\n\" when
+using rlogin or telnet to communicate with the server.")
+
+(defvoo nntp-large-newsgroup 50
+ "*The number of the articles which indicates a large newsgroup.
+If the number of the articles is greater than the value, verbose
+messages will be shown to indicate the current status.")
+
+(defvoo nntp-maximum-request 400
+ "*The maximum number of the requests sent to the NNTP server at one time.
+If Emacs hangs up while retrieving headers, set the variable to a
+lower value.")
+
+(defvoo nntp-nov-is-evil nil
+ "*If non-nil, nntp will never attempt to use XOVER when talking to the server.")
+
+(defvoo nntp-xover-commands '("XOVER" "XOVERVIEW")
+ "*List of strings that are used as commands to fetch NOV lines from a server.
+The strings are tried in turn until a positive response is gotten. If
+none of the commands are successful, nntp will just grab headers one
+by one.")
+
+(defvoo nntp-nov-gap 5
+ "*Maximum allowed gap between two articles.
+If the gap between two consecutive articles is bigger than this
+variable, split the XOVER request into two requests.")
+
+(defvoo nntp-connection-timeout nil
+ "*Number of seconds to wait before an nntp connection times out.
+If this variable is nil, which is the default, no timers are set.")
+
+(defvoo nntp-prepare-server-hook nil
+ "*Hook run before a server is opened.
+If can be used to set up a server remotely, for instance. Say you
+have an account at the machine \"other.machine\". This machine has
+access to an NNTP server that you can't access locally. You could
+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-warn-about-losing-connection t
+ "*If non-nil, beep when a server closes connection.")
+
+(defvoo nntp-coding-system-for-read nil
+ "*coding-system for read from NNTP.")
+
+\f
+
+;;; Internal variables.
+
+(defvar nntp-have-messaged nil)
+
+(defvar nntp-process-wait-for nil)
+(defvar nntp-process-to-buffer nil)
+(defvar nntp-process-callback nil)
+(defvar nntp-process-decode nil)
+(defvar nntp-process-start-point nil)
+(defvar nntp-inside-change-function nil)
+
+(defvar nntp-connection-list nil)
+
+(defvoo nntp-server-type nil)
+(defvoo nntp-connection-alist nil)
+(defvoo nntp-status-string "")
+(defconst nntp-version "nntp 5.0")
+(defvoo nntp-inhibit-erase nil)
+(defvoo nntp-inhibit-output nil)
+
+(defvoo nntp-server-xover 'try)
+(defvoo nntp-server-list-active-group 'try)
+
+(eval-and-compile
+ (autoload 'nnmail-read-passwd "nnmail"))
+
+\f
+
+;;; Internal functions.
+
+(defsubst nntp-send-string (process string)
+ "Send STRING to PROCESS."
+ (process-send-string process (concat string nntp-end-of-line)))
+
+(defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
+ "Wait for WAIT-FOR to arrive from PROCESS."
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char (point-min))
+ (while (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
+ (looking-at "480"))
+ (when (looking-at "480")
+ (erase-buffer)
+ (funcall nntp-authinfo-function))
+ (nntp-accept-process-output process)
+ (goto-char (point-min)))
+ (prog1
+ (if (looking-at "[45]")
+ (progn
+ (nntp-snarf-error-message)
+ nil)
+ (goto-char (point-max))
+ (let ((limit (point-min)))
+ (while (not (re-search-backward wait-for limit t))
+ ;; We assume that whatever we wait for is less than 1000
+ ;; characters long.
+ (setq limit (max (- (point-max) 1000) (point-min)))
+ (nntp-accept-process-output process)
+ (goto-char (point-max))))
+ (nntp-decode-text (not decode))
+ (unless discard
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-max))
+ (insert-buffer-substring (process-buffer process))
+ ;; Nix out "nntp reading...." message.
+ (when nntp-have-messaged
+ (setq nntp-have-messaged nil)
+ (message ""))
+ t)))
+ (unless discard
+ (erase-buffer)))))
+
+(defsubst nntp-find-connection (buffer)
+ "Find the connection delivering to BUFFER."
+ (let ((alist nntp-connection-alist)
+ (buffer (if (stringp buffer) (get-buffer buffer) buffer))
+ process entry)
+ (while (setq entry (pop alist))
+ (when (eq buffer (cadr entry))
+ (setq process (car entry)
+ alist nil)))
+ (when process
+ (if (memq (process-status process) '(open run))
+ process
+ (when (buffer-name (process-buffer process))
+ (kill-buffer (process-buffer process)))
+ (setq nntp-connection-alist (delq entry nntp-connection-alist))
+ nil))))
+
+(defsubst nntp-find-connection-entry (buffer)
+ "Return the entry for the connection to BUFFER."
+ (assq (nntp-find-connection buffer) nntp-connection-alist))
+
+(defun nntp-find-connection-buffer (buffer)
+ "Return the process connection buffer tied to BUFFER."
+ (let ((process (nntp-find-connection buffer)))
+ (when process
+ (process-buffer process))))
+
+(defsubst nntp-retrieve-data (command address port buffer
+ &optional wait-for callback decode)
+ "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."
+ (let ((process (or (nntp-find-connection buffer)
+ (nntp-open-connection buffer))))
+ (if (not process)
+ (nnheader-report 'nntp "Couldn't open connection to %s" address)
+ (unless (or nntp-inhibit-erase nnheader-callback-function)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (erase-buffer)))
+ (when command
+ (nntp-send-string process command))
+ (cond
+ ((eq callback 'ignore)
+ t)
+ ((and callback wait-for)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (unless nntp-inside-change-function
+ (erase-buffer))
+ (setq nntp-process-decode decode
+ nntp-process-to-buffer buffer
+ nntp-process-wait-for wait-for
+ nntp-process-callback callback
+ nntp-process-start-point (point-max)
+ after-change-functions
+ (list 'nntp-after-change-function-callback)))
+ t)
+ (wait-for
+ (nntp-wait-for process wait-for buffer decode))
+ (t t)))))
+
+(defsubst nntp-send-command (wait-for &rest strings)
+ "Send STRINGS to server and wait until WAIT-FOR returns."
+ (when (and (not nnheader-callback-function)
+ (not nntp-inhibit-output))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)))
+ (nntp-retrieve-data
+ (mapconcat 'identity strings " ")
+ nntp-address nntp-port-number nntp-server-buffer
+ wait-for nnheader-callback-function))
+
+(defun nntp-send-command-nodelete (wait-for &rest strings)
+ "Send STRINGS to server and wait until WAIT-FOR returns."
+ (nntp-retrieve-data
+ (mapconcat 'identity strings " ")
+ nntp-address nntp-port-number nntp-server-buffer
+ wait-for nnheader-callback-function))
+
+(defun nntp-send-command-and-decode (wait-for &rest strings)
+ "Send STRINGS to server and wait until WAIT-FOR returns."
+ (when (and (not nnheader-callback-function)
+ (not nntp-inhibit-output))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)))
+ (nntp-retrieve-data
+ (mapconcat 'identity strings " ")
+ nntp-address nntp-port-number nntp-server-buffer
+ wait-for nnheader-callback-function t))
+
+(defun nntp-send-buffer (wait-for)
+ "Send the current buffer to server and wait until WAIT-FOR returns."
+ (when (and (not nnheader-callback-function)
+ (not nntp-inhibit-output))
+ (save-excursion
+ (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
+ (erase-buffer)))
+ (nntp-encode-text)
+ (process-send-region (nntp-find-connection nntp-server-buffer)
+ (point-min) (point-max))
+ (nntp-retrieve-data
+ nil nntp-address nntp-port-number nntp-server-buffer
+ wait-for nnheader-callback-function))
+
+\f
+
+;;; Interface functions.
+
+(nnoo-define-basics nntp)
+
+(defsubst nntp-next-result-arrived-p ()
+ (let ((point (point)))
+ (cond
+ ((eq (following-char) ?2)
+ (if (re-search-forward "\n\\.\r?\n" nil t)
+ t
+ (goto-char point)
+ nil))
+ ((looking-at "[34]")
+ (forward-line 1)
+ t)
+ (t
+ nil))))
+
+(deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
+ "Retrieve the headers of ARTICLES."
+ (nntp-possibly-change-group group server)
+ (save-excursion
+ (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
+ (erase-buffer)
+ (if (and (not gnus-nov-is-evil)
+ (not nntp-nov-is-evil)
+ (nntp-retrieve-headers-with-xover articles fetch-old))
+ ;; We successfully retrieved the headers via XOVER.
+ 'nov
+ ;; XOVER didn't work, so we do it the hard, slow and inefficient
+ ;; way.
+ (let ((number (length articles))
+ (count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (nntp-inhibit-erase t)
+ article)
+ ;; Send HEAD commands.
+ (while (setq article (pop articles))
+ (nntp-send-command
+ nil
+ "HEAD" (if (numberp article)
+ (int-to-string article)
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ article))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (nntp-next-result-arrived-p)
+ (setq last-point (point))
+ (incf received))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (nnheader-message 6 "NNTP: Receiving headers... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (nnheader-message 6 "NNTP: Receiving headers...done"))
+
+ ;; Now all of replies are received. Fold continuation lines.
+ (nnheader-fold-continuation-lines)
+ ;; Remove all "\r"'s.
+ (nnheader-strip-cr)
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ 'headers))))
+
+(deffoo nntp-retrieve-groups (groups &optional server)
+ "Retrieve group info on GROUPS."
+ (nntp-possibly-change-group nil server)
+ (save-excursion
+ (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
+ ;; The first time this is run, this variable is `try'. So we
+ ;; try.
+ (when (eq nntp-server-list-active-group 'try)
+ (nntp-try-list-active (car groups)))
+ (erase-buffer)
+ (let ((count 0)
+ (received 0)
+ (last-point (point-min))
+ (nntp-inhibit-erase t)
+ (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP")))
+ (while groups
+ ;; Send the command to the server.
+ (nntp-send-command nil command (pop groups))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null groups) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (incf received))
+ (setq last-point (point))
+ (< received count))
+ (nntp-accept-response))))
+
+ ;; Wait for the reply from the final command.
+ (goto-char (point-max))
+ (re-search-backward "^[0-9]" nil t)
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (point-max))
+ (if (not nntp-server-list-active-group)
+ (not (re-search-backward "\r?\n" (- (point) 3) t))
+ (not (re-search-backward "^\\.\r?\n" (- (point) 4) t))))
+ (nntp-accept-response)))
+
+ ;; Now all replies are received. We remove CRs.
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t))
+
+ (if (not nntp-server-list-active-group)
+ (progn
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ 'group)
+ ;; We have read active entries, so we just delete the
+ ;; superfluous gunk.
+ (goto-char (point-min))
+ (while (re-search-forward "^[.2-5]" nil t)
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point))))
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ 'active))))
+
+(deffoo nntp-retrieve-articles (articles &optional group server)
+ (nntp-possibly-change-group group server)
+ (save-excursion
+ (let ((number (length articles))
+ (count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (nntp-inhibit-erase t)
+ (map (apply 'vector articles))
+ (point 1)
+ article alist)
+ (set-buffer buf)
+ (erase-buffer)
+ ;; Send ARTICLE command.
+ (while (setq article (pop articles))
+ (nntp-send-command
+ nil
+ "ARTICLE" (if (numberp article)
+ (int-to-string article)
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ article))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (nntp-next-result-arrived-p)
+ (aset map received (cons (aref map received) (point)))
+ (setq last-point (point))
+ (incf received))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (nnheader-message 6 "NNTP: Receiving articles... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (nnheader-message 6 "NNTP: Receiving articles...done"))
+
+ ;; Now we have all the responses. We go through the results,
+ ;; washes it and copies it over to the server buffer.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (setq last-point (point-min))
+ (mapcar
+ (lambda (entry)
+ (narrow-to-region
+ (setq point (goto-char (point-max)))
+ (progn
+ (insert-buffer-substring buf last-point (cdr entry))
+ (point-max)))
+ (setq last-point (cdr entry))
+ (nntp-decode-text)
+ (widen)
+ (cons (car entry) point))
+ map))))
+
+(defun nntp-try-list-active (group)
+ (nntp-list-active-group group)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (cond ((or (eobp)
+ (looking-at "5[0-9]+"))
+ (setq nntp-server-list-active-group nil))
+ (t
+ (setq nntp-server-list-active-group t)))))
+
+(deffoo nntp-list-active-group (group &optional server)
+ "Return the active info on GROUP (which can be a regexp."
+ (nntp-possibly-change-group nil server)
+ (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group))
+
+(deffoo nntp-request-article (article &optional group server buffer command)
+ (nntp-possibly-change-group group server)
+ (when (nntp-send-command-and-decode
+ "\r?\n\\.\r?\n" "ARTICLE"
+ (if (numberp article) (int-to-string article) article))
+ (if (and buffer
+ (not (equal buffer nntp-server-buffer)))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (copy-to-buffer buffer (point-min) (point-max))
+ (nntp-find-group-and-number))
+ (nntp-find-group-and-number))))
+
+(deffoo nntp-request-head (article &optional group server)
+ (nntp-possibly-change-group group server)
+ (when (nntp-send-command
+ "\r?\n\\.\r?\n" "HEAD"
+ (if (numberp article) (int-to-string article) article))
+ (prog1
+ (nntp-find-group-and-number)
+ (nntp-decode-text))))
+
+(deffoo nntp-request-body (article &optional group server)
+ (nntp-possibly-change-group group server)
+ (nntp-send-command-and-decode
+ "\r?\n\\.\r?\n" "BODY"
+ (if (numberp article) (int-to-string article) article)))
+
+(deffoo nntp-request-group (group &optional server dont-check)
+ (nntp-possibly-change-group nil server)
+ (when (nntp-send-command "^2.*\n" "GROUP" group)
+ (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
+ (setcar (cddr entry) group))))
+
+(deffoo nntp-close-group (group &optional server)
+ t)
+
+(deffoo nntp-server-opened (&optional server)
+ "Say whether a connection to SERVER has been opened."
+ (and (nnoo-current-server-p 'nntp server)
+ nntp-server-buffer
+ (gnus-buffer-live-p nntp-server-buffer)
+ (nntp-find-connection nntp-server-buffer)))
+
+(deffoo nntp-open-server (server &optional defs connectionless)
+ (nnheader-init-server-buffer)
+ (if (nntp-server-opened server)
+ t
+ (when (or (stringp (car defs))
+ (numberp (car defs)))
+ (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs))))
+ (unless (assq 'nntp-address defs)
+ (setq defs (append defs (list (list 'nntp-address server)))))
+ (nnoo-change-server 'nntp server defs)
+ (unless connectionless
+ (or (nntp-find-connection nntp-server-buffer)
+ (nntp-open-connection nntp-server-buffer)))))
+
+(deffoo nntp-close-server (&optional server)
+ (nntp-possibly-change-group nil server t)
+ (let (process)
+ (while (setq process (car (pop nntp-connection-alist)))
+ (when (memq (process-status process) '(open run))
+ (set-process-sentinel process nil)
+ (ignore-errors
+ (nntp-send-string process "QUIT")))
+ (when (buffer-name (process-buffer process))
+ (kill-buffer (process-buffer process))))
+ (nnoo-close-server 'nntp)))
+
+(deffoo nntp-request-close ()
+ (let (process)
+ (while (setq process (pop nntp-connection-list))
+ (when (memq (process-status process) '(open run))
+ (set-process-sentinel process nil)
+ (ignore-errors
+ (nntp-send-string process "QUIT")))
+ (when (buffer-name (process-buffer process))
+ (kill-buffer (process-buffer process))))))
+
+(deffoo nntp-request-list (&optional server)
+ (nntp-possibly-change-group nil server)
+ (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST"))
+
+(deffoo nntp-request-list-newsgroups (&optional server)
+ (nntp-possibly-change-group nil server)
+ (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS"))
+
+(deffoo nntp-request-newgroups (date &optional server)
+ (nntp-possibly-change-group nil server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let* ((date (timezone-parse-date date))
+ (time-string
+ (format "%s%02d%02d %s%s%s"
+ (substring (aref date 0) 2) (string-to-int (aref date 1))
+ (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
+ (substring
+ (aref date 3) 3 5) (substring (aref date 3) 6 8))))
+ (prog1
+ (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
+ (nntp-decode-text)))))
+
+(deffoo nntp-request-post (&optional server)
+ (nntp-possibly-change-group nil server)
+ (when (nntp-send-command "^[23].*\r?\n" "POST")
+ (nntp-send-buffer "^[23].*\n")))
+
+(deffoo nntp-request-type (group article)
+ 'news)
+
+(deffoo nntp-asynchronous-p ()
+ t)
+
+;;; Hooky functions.
+
+(defun nntp-send-mode-reader ()
+ "Send the MODE READER command to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will make innd servers spawn an nnrpd process to allow actual article
+reading."
+ (nntp-send-command "^.*\r?\n" "MODE READER"))
+
+(defun nntp-send-nosy-authinfo ()
+ "Send the AUTHINFO to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will prompt for a password."
+ (nntp-send-command
+ "^.*\r?\n" "AUTHINFO USER"
+ (read-string (format "NNTP (%s) user name: " nntp-address)))
+ (nntp-send-command
+ "^.*\r?\n" "AUTHINFO PASS"
+ (nnmail-read-passwd "NNTP (%s) password: " nntp-address)))
+
+(defun nntp-send-authinfo ()
+ "Send the AUTHINFO to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will prompt for a password."
+ (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
+ (nntp-send-command
+ "^.*\r?\n" "AUTHINFO PASS"
+ (nnmail-read-passwd (format "NNTP (%s) password: " nntp-address))))
+
+(defun nntp-send-authinfo-from-file ()
+ "Send the AUTHINFO to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'."
+ (when (file-exists-p "~/.nntp-authinfo")
+ (nnheader-temp-write nil
+ (insert-file-contents "~/.nntp-authinfo")
+ (goto-char (point-min))
+ (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
+ (nntp-send-command
+ "^.*\r?\n" "AUTHINFO PASS"
+ (buffer-substring (point) (progn (end-of-line) (point)))))))
+
+;;; Internal functions.
+
+(defun nntp-make-process-buffer (buffer)
+ "Create a new, fresh buffer usable for nntp process connections."
+ (save-excursion
+ (set-buffer
+ (generate-new-buffer
+ (format " *server %s %s %s*"
+ nntp-address nntp-port-number
+ (buffer-name (get-buffer buffer)))))
+ (buffer-disable-undo (current-buffer))
+ (set (make-local-variable 'after-change-functions) nil)
+ (set (make-local-variable 'nntp-process-wait-for) nil)
+ (set (make-local-variable 'nntp-process-callback) nil)
+ (set (make-local-variable 'nntp-process-to-buffer) nil)
+ (set (make-local-variable 'nntp-process-start-point) nil)
+ (set (make-local-variable 'nntp-process-decode) nil)
+ (current-buffer)))
+
+(defun nntp-open-connection (buffer)
+ "Open a connection to PORT on ADDRESS delivering output to BUFFER."
+ (run-hooks 'nntp-prepare-server-hook)
+ (let* ((pbuffer (nntp-make-process-buffer buffer))
+ (process
+ (condition-case ()
+ (let ((coding-system-for-read nntp-coding-system-for-read))
+ (funcall nntp-open-connection-function pbuffer))
+ (error nil)
+ (quit nil))))
+ (when process
+ (process-kill-without-query process)
+ (nntp-wait-for process "^.*\n" buffer nil t)
+ (if (memq (process-status process) '(open run))
+ (prog1
+ (caar (push (list process buffer nil) nntp-connection-alist))
+ (push process nntp-connection-list)
+ (save-excursion
+ (set-buffer pbuffer)
+ (nntp-read-server-type)
+ (erase-buffer)
+ (set-buffer nntp-server-buffer)
+ (let ((nnheader-callback-function nil))
+ (run-hooks 'nntp-server-opened-hook))))
+ (when (buffer-name (process-buffer process))
+ (kill-buffer (process-buffer process)))
+ nil))))
+
+(defun nntp-open-network-stream (buffer)
+ (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
+
+(defun nntp-read-server-type ()
+ "Find out what the name of the server we have connected to is."
+ ;; Wait for the status string to arrive.
+ (setq nntp-server-type (buffer-string))
+ (let ((alist nntp-server-action-alist)
+ (case-fold-search t)
+ entry)
+ ;; Run server-specific commands.
+ (while alist
+ (setq entry (pop alist))
+ (when (string-match (car entry) nntp-server-type)
+ (if (and (listp (cadr entry))
+ (not (eq 'lambda (caadr entry))))
+ (eval (cadr entry))
+ (funcall (cadr entry)))))))
+
+(defun nntp-after-change-function-callback (beg end len)
+ (when nntp-process-callback
+ (save-match-data
+ (if (and (= beg (point-min))
+ (memq (char-after beg) '(?4 ?5)))
+ ;; Report back error messages.
+ (save-excursion
+ (goto-char beg)
+ (if (looking-at "480")
+ (funcall nntp-authinfo-function)
+ (nntp-snarf-error-message)
+ (funcall nntp-process-callback nil)))
+ (goto-char end)
+ (when (and (> (point) nntp-process-start-point)
+ (re-search-backward nntp-process-wait-for
+ nntp-process-start-point t))
+ (when (buffer-name (get-buffer nntp-process-to-buffer))
+ (let ((cur (current-buffer))
+ (start nntp-process-start-point))
+ (save-excursion
+ (set-buffer (get-buffer nntp-process-to-buffer))
+ (goto-char (point-max))
+ (let ((b (point)))
+ (insert-buffer-substring cur start)
+ (narrow-to-region b (point-max))
+ (nntp-decode-text)
+ (widen)))))
+ (goto-char end)
+ (let ((callback nntp-process-callback)
+ (nntp-inside-change-function t))
+ (setq nntp-process-callback nil)
+ (save-excursion
+ (funcall callback (buffer-name
+ (get-buffer nntp-process-to-buffer))))))))))
+
+(defun nntp-snarf-error-message ()
+ "Save the error message in the current buffer."
+ (let ((message (buffer-string)))
+ (while (string-match "[\r\n]+" message)
+ (setq message (replace-match " " t t message)))
+ (nnheader-report 'nntp message)
+ message))
+
+(defun nntp-accept-process-output (process)
+ "Wait for output from PROCESS and message some dots."
+ (save-excursion
+ (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
+ nntp-server-buffer))
+ (let ((len (/ (point-max) 1024))
+ message-log-max)
+ (unless (< len 10)
+ (setq nntp-have-messaged t)
+ (nnheader-message 7 "nntp read: %dk" len)))
+ (accept-process-output process 1)))
+
+(defun nntp-accept-response ()
+ "Wait for output from the process that outputs to BUFFER."
+ (nntp-accept-process-output (nntp-find-connection nntp-server-buffer)))
+
+(defun nntp-possibly-change-group (group server &optional connectionless)
+ (let ((nnheader-callback-function nil))
+ (when server
+ (or (nntp-server-opened server)
+ (nntp-open-server server nil connectionless)))
+
+ (unless connectionless
+ (or (nntp-find-connection nntp-server-buffer)
+ (nntp-open-connection nntp-server-buffer))))
+
+ (when group
+ (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
+ (when (not (equal group (caddr entry)))
+ (save-excursion
+ (set-buffer (process-buffer (car entry)))
+ (erase-buffer)
+ (nntp-send-string (car entry) (concat "GROUP " group))
+ (nntp-wait-for-string "^2.*\n")
+ (setcar (cddr entry) group)
+ (erase-buffer))))))
+
+(defun nntp-decode-text (&optional cr-only)
+ "Decode the text in the current buffer."
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (delete-char -1))
+ (unless cr-only
+ ;; Remove trailing ".\n" end-of-transfer marker.
+ (goto-char (point-max))
+ (forward-line -1)
+ (when (looking-at ".\n")
+ (delete-char 2))
+ ;; Delete status line.
+ (goto-char (point-min))
+ (delete-region (point) (progn (forward-line 1) (point)))
+ ;; Remove "." -> ".." encoding.
+ (while (search-forward "\n.." nil t)
+ (delete-char -1))))
+
+(defun nntp-encode-text ()
+ "Encode the text in the current buffer."
+ (save-excursion
+ ;; Replace "." at beginning of line with "..".
+ (goto-char (point-min))
+ (while (re-search-forward "^\\." nil t)
+ (insert "."))
+ (goto-char (point-max))
+ ;; Insert newline at the end of the buffer.
+ (unless (bolp)
+ (insert "\n"))
+ ;; Insert `.' at end of buffer (end of text mark).
+ (goto-char (point-max))
+ (insert "." nntp-end-of-line)))
+
+(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (cond
+
+ ;; This server does not talk NOV.
+ ((not nntp-server-xover)
+ nil)
+
+ ;; We don't care about gaps.
+ ((or (not nntp-nov-gap)
+ fetch-old)
+ (nntp-send-xover-command
+ (if fetch-old
+ (if (numberp fetch-old)
+ (max 1 (- (car articles) fetch-old))
+ 1)
+ (car articles))
+ (car (last articles)) 'wait)
+
+ (goto-char (point-min))
+ (when (looking-at "[1-5][0-9][0-9] ")
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t))
+ (goto-char (point-max))
+ (forward-line -1)
+ (when (looking-at "\\.")
+ (delete-region (point) (progn (forward-line 1) (point)))))
+
+ ;; We do it the hard way. For each gap, an XOVER command is sent
+ ;; to the server. We do not wait for a reply from the server, we
+ ;; just send them off as fast as we can. That means that we have
+ ;; to count the number of responses we get back to find out when we
+ ;; have gotten all we asked for.
+ ((numberp nntp-nov-gap)
+ (let ((count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf nntp-server-buffer)
+ ;;(process-buffer (nntp-find-connection (current-buffer))))
+ first)
+ ;; We have to check `nntp-server-xover'. If it gets set to nil,
+ ;; that means that the server does not understand XOVER, but we
+ ;; won't know that until we try.
+ (while (and nntp-server-xover articles)
+ (setq first (car articles))
+ ;; Search forward until we find a gap, or until we run out of
+ ;; articles.
+ (while (and (cdr articles)
+ (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
+ (setq articles (cdr articles)))
+
+ (when (nntp-send-xover-command first (car articles))
+ (setq articles (cdr articles)
+ count (1+ count))
+
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (accept-process-output)
+ ;; On some Emacs versions the preceding function has
+ ;; a tendency to change the buffer. Perhaps. It's
+ ;; quite difficult to reproduce, because it only
+ ;; seems to happen once in a blue moon.
+ (set-buffer buf)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ (accept-process-output)
+ (set-buffer buf)))))
+
+ (when nntp-server-xover
+ ;; Wait for the reply from the final command.
+ (goto-char (point-max))
+ (re-search-backward "^[0-9][0-9][0-9] " nil t)
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (looking-at "^\\.\r?\n")))
+ (nntp-accept-response)))
+
+ ;; We remove any "." lines and status lines.
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (delete-char -1))
+ (goto-char (point-min))
+ (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")
+ ;;(copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ t))))
+
+ nntp-server-xover)
+
+(defun nntp-send-xover-command (beg end &optional wait-for-reply)
+ "Send the XOVER command to the server."
+ (let ((range (format "%d-%d" beg end))
+ (nntp-inhibit-erase t))
+ (if (stringp nntp-server-xover)
+ ;; If `nntp-server-xover' is a string, then we just send this
+ ;; command.
+ (if wait-for-reply
+ (nntp-send-command-nodelete
+ "\r?\n\\.\r?\n" nntp-server-xover range)
+ ;; We do not wait for the reply.
+ (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range))
+ (let ((commands nntp-xover-commands))
+ ;; `nntp-xover-commands' is a list of possible XOVER commands.
+ ;; We try them all until we get at positive response.
+ (while (and commands (eq nntp-server-xover 'try))
+ (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (and (looking-at "[23]") ; No error message.
+ ;; We also have to look at the lines. Some buggy
+ ;; servers give back simple lines with just the
+ ;; article number. How... helpful.
+ (progn
+ (forward-line 1)
+ (looking-at "[0-9]+\t...")) ; More text after number.
+ (setq nntp-server-xover (car commands))))
+ (setq commands (cdr commands)))
+ ;; If none of the commands worked, we disable XOVER.
+ (when (eq nntp-server-xover 'try)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (setq nntp-server-xover nil)))
+ nntp-server-xover))))
+
+;;; Alternative connection methods.
+
+(defun nntp-wait-for-string (regexp)
+ "Wait until string arrives in the buffer."
+ (let ((buf (current-buffer)))
+ (goto-char (point-min))
+ (while (not (re-search-forward regexp nil t))
+ (accept-process-output (nntp-find-connection nntp-server-buffer))
+ (set-buffer buf)
+ (goto-char (point-min)))))
+
+(defun nntp-open-telnet (buffer)
+ (save-excursion
+ (set-buffer buffer)
+ (erase-buffer)
+ (let ((proc (apply
+ 'start-process
+ "nntpd" buffer nntp-telnet-command nntp-telnet-switches))
+ (case-fold-search t))
+ (when (memq (process-status proc) '(open run))
+ (process-send-string proc "set escape \^X\n")
+ (process-send-string proc (concat "open " nntp-address "\n"))
+ (nntp-wait-for-string "^\r*.?login:")
+ (process-send-string
+ proc (concat
+ (or nntp-telnet-user-name
+ (setq nntp-telnet-user-name (read-string "login: ")))
+ "\n"))
+ (nntp-wait-for-string "^\r*.?password:")
+ (process-send-string
+ proc (concat
+ (or nntp-telnet-passwd
+ (setq nntp-telnet-passwd
+ (nnmail-read-passwd "Password: ")))
+ "\n"))
+ (erase-buffer)
+ (nntp-wait-for-string "bash\\|\$ *\r?$\\|> *\r?")
+ (process-send-string
+ proc (concat (mapconcat 'identity nntp-telnet-parameters " ") "\n"))
+ (nntp-wait-for-string "^\r*200")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ (process-send-string proc "\^]")
+ (nntp-wait-for-string "^telnet")
+ (process-send-string proc "mode character\n")
+ (accept-process-output proc 1)
+ (sit-for 1)
+ (goto-char (point-min))
+ (forward-line 1)
+ (delete-region (point) (point-max)))
+ proc)))
+
+(defun nntp-open-rlogin (buffer)
+ "Open a connection to SERVER using rsh."
+ (let ((proc (if nntp-rlogin-user-name
+ (start-process
+ "nntpd" buffer nntp-rlogin-program
+ nntp-address "-l" nntp-rlogin-user-name
+ (mapconcat 'identity
+ nntp-rlogin-parameters " "))
+ (start-process
+ "nntpd" buffer nntp-rlogin-program nntp-address
+ (mapconcat 'identity
+ nntp-rlogin-parameters " ")))))
+ (set-buffer buffer)
+ (nntp-wait-for-string "^\r*200")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc))
+
+(defun nntp-find-group-and-number ()
+ (save-excursion
+ (save-restriction
+ (set-buffer nntp-server-buffer)
+ (narrow-to-region (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (goto-char (point-min))
+ ;; We first find the number by looking at the status line.
+ (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
+ (string-to-int
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ group newsgroups xref)
+ (and number (zerop number) (setq number nil))
+ ;; Then we find the group name.
+ (setq group
+ (cond
+ ;; If there is only one group in the Newsgroups header,
+ ;; then it seems quite likely that this article comes
+ ;; from that group, I'd say.
+ ((and (setq newsgroups (mail-fetch-field "newsgroups"))
+ (not (string-match "," newsgroups)))
+ newsgroups)
+ ;; If there is more than one group in the Newsgroups
+ ;; header, then the Xref header should be filled out.
+ ;; We hazard a guess that the group that has this
+ ;; article number in the Xref header is the one we are
+ ;; looking for. This might very well be wrong if this
+ ;; article happens to have the same number in several
+ ;; groups, but that's life.
+ ((and (setq xref (mail-fetch-field "xref"))
+ number
+ (string-match (format "\\([^ :]+\\):%d" number) xref))
+ (substring xref (match-beginning 1) (match-end 1)))
+ (t "")))
+ (when (string-match "\r" group)
+ (setq group (substring group 0 (match-beginning 0))))
+ (cons group number)))))
+
+(provide 'nntp)
+
+;;; nntp.el ends here
--- /dev/null
+;;; nnvirtual.el --- virtual newsgroups access for Gnus
+;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc.
+
+;; Author: David Moore <dmoore@ucsd.edu>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; The other access methods (nntp, nnspool, etc) are general news
+;; access methods. This module relies on Gnus and can not be used
+;; separately.
+
+;;; Code:
+
+(require 'nntp)
+(require 'nnheader)
+(require 'gnus)
+(require 'nnoo)
+(require 'gnus-util)
+(require 'gnus-start)
+(require 'gnus-sum)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nnvirtual)
+
+(defvoo nnvirtual-always-rescan nil
+ "*If non-nil, always scan groups for unread articles when entering a group.
+If this variable is nil (which is the default) and you read articles
+in a component group after the virtual group has been activated, the
+read articles from the component group will show up when you enter the
+virtual group.")
+
+(defvoo nnvirtual-component-regexp nil
+ "*Regexp to match component groups.")
+
+(defvoo nnvirtual-component-groups nil
+ "Component group in this nnvirtual group.")
+
+\f
+
+(defconst nnvirtual-version "nnvirtual 1.1")
+
+(defvoo nnvirtual-current-group nil)
+
+(defvoo nnvirtual-mapping-table nil
+ "Table of rules on how to map between component group and article number
+to virtual article number.")
+
+(defvoo nnvirtual-mapping-offsets nil
+ "Table indexed by component group to an offset to be applied to article numbers in that group.")
+
+(defvoo nnvirtual-mapping-len 0
+ "Number of articles in this virtual group.")
+
+(defvoo nnvirtual-mapping-reads nil
+ "Compressed sequence of read articles on the virtual group as computed from the unread status of individual component groups.")
+
+(defvoo nnvirtual-mapping-marks nil
+ "Compressed marks alist for the virtual group as computed from the marks of individual component groups.")
+
+(defvoo nnvirtual-info-installed nil
+ "T if we have already installed the group info for this group, and shouldn't blast over it again.")
+
+(defvoo nnvirtual-status-string "")
+
+(eval-and-compile
+ (autoload 'gnus-cache-articles-in-group "gnus-cache"))
+
+\f
+
+;;; Interface functions.
+
+(nnoo-define-basics nnvirtual)
+
+
+(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
+ server fetch-old)
+ (when (nnvirtual-possibly-change-server server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (if (stringp (car articles))
+ 'headers
+ (let ((vbuf (nnheader-set-temp-buffer
+ (get-buffer-create " *virtual headers*")))
+ (carticles (nnvirtual-partition-sequence articles))
+ (system-name (system-name))
+ cgroup carticle article result prefix)
+ (while carticles
+ (setq cgroup (caar carticles))
+ (setq articles (cdar carticles))
+ (pop carticles)
+ (when (and articles
+ (gnus-check-server
+ (gnus-find-method-for-group cgroup) t)
+ (gnus-request-group cgroup t)
+ (setq prefix (gnus-group-real-prefix cgroup))
+ ;; FIX FIX FIX we want to check the cache!
+ ;; This is probably evil if people have set
+ ;; gnus-use-cache to nil themselves, but I
+ ;; have no way of finding the true value of it.
+ (let ((gnus-use-cache t))
+ (setq result (gnus-retrieve-headers
+ articles cgroup nil))))
+ (set-buffer nntp-server-buffer)
+ ;; If we got HEAD headers, we convert them into NOV
+ ;; headers. This is slow, inefficient and, come to think
+ ;; of it, downright evil. So sue me. I couldn't be
+ ;; bothered to write a header parse routine that could
+ ;; parse a mixed HEAD/NOV buffer.
+ (when (eq result 'headers)
+ (nnvirtual-convert-headers))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (delete-region (point)
+ (progn
+ (setq carticle (read nntp-server-buffer))
+ (point)))
+
+ ;; We remove this article from the articles list, if
+ ;; anything is left in the articles list after going through
+ ;; the entire buffer, then those articles have been
+ ;; expired or canceled, so we appropriately update the
+ ;; component group below. They should be coming up
+ ;; generally in order, so this shouldn't be slow.
+ (setq articles (delq carticle articles))
+
+ (setq article (nnvirtual-reverse-map-article cgroup carticle))
+ (if (null article)
+ ;; This line has no reverse mapping, that means it
+ ;; was an extra article reference returned by nntp.
+ (progn
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ;; Otherwise insert the virtual article number,
+ ;; and clean up the xrefs.
+ (princ article nntp-server-buffer)
+ (nnvirtual-update-xref-header cgroup carticle
+ prefix system-name)
+ (forward-line 1))
+ )
+
+ (set-buffer vbuf)
+ (goto-char (point-max))
+ (insert-buffer-substring nntp-server-buffer))
+ ;; Anything left in articles is expired or canceled.
+ ;; Could be smart and not tell it about articles already known?
+ (when articles
+ (gnus-group-make-articles-read cgroup articles))
+ )
+
+ ;; The headers are ready for reading, so they are inserted into
+ ;; the nntp-server-buffer, which is where Gnus expects to find
+ ;; them.
+ (prog1
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring vbuf)
+ ;; FIX FIX FIX, we should be able to sort faster than
+ ;; this if needed, since each cgroup is sorted, we just
+ ;; need to merge
+ (sort-numeric-fields 1 (point-min) (point-max))
+ 'nov)
+ (kill-buffer vbuf)))))))
+
+
+(defvoo nnvirtual-last-accessed-component-group nil)
+
+(deffoo nnvirtual-request-article (article &optional group server buffer)
+ (when (nnvirtual-possibly-change-server server)
+ (if (stringp article)
+ ;; This is a fetch by Message-ID.
+ (cond
+ ((not nnvirtual-last-accessed-component-group)
+ (nnheader-report
+ 'nnvirtual "Don't know what server to request from"))
+ (t
+ (save-excursion
+ (when buffer
+ (set-buffer buffer))
+ (let ((method (gnus-find-method-for-group
+ nnvirtual-last-accessed-component-group)))
+ (funcall (gnus-get-function method 'request-article)
+ article nil (nth 1 method) buffer)))))
+ ;; This is a fetch by number.
+ (let* ((amap (nnvirtual-map-article article))
+ (cgroup (car amap)))
+ (cond
+ ((not amap)
+ (nnheader-report 'nnvirtual "No such article: %s" article))
+ ((not (gnus-check-group cgroup))
+ (nnheader-report
+ 'nnvirtual "Can't open server where %s exists" cgroup))
+ ((not (gnus-request-group cgroup t))
+ (nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
+ (t
+ (setq nnvirtual-last-accessed-component-group cgroup)
+ (if buffer
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-request-article-this-buffer (cdr amap) cgroup))
+ (gnus-request-article (cdr amap) cgroup))))))))
+
+
+(deffoo nnvirtual-open-server (server &optional defs)
+ (unless (assq 'nnvirtual-component-regexp defs)
+ (push `(nnvirtual-component-regexp ,server)
+ defs))
+ (nnoo-change-server 'nnvirtual server defs)
+ (if nnvirtual-component-groups
+ t
+ (setq nnvirtual-mapping-table nil
+ nnvirtual-mapping-offsets nil
+ nnvirtual-mapping-len 0
+ nnvirtual-mapping-reads nil
+ nnvirtual-mapping-marks nil
+ nnvirtual-info-installed nil)
+ (when nnvirtual-component-regexp
+ ;; Go through the newsrc alist and find all component groups.
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ group)
+ (while (setq group (car (pop newsrc)))
+ (when (string-match nnvirtual-component-regexp group) ; Match
+ ;; Add this group to the list of component groups.
+ (setq nnvirtual-component-groups
+ (cons group (delete group nnvirtual-component-groups)))))))
+ (if (not nnvirtual-component-groups)
+ (nnheader-report 'nnvirtual "No component groups: %s" server)
+ t)))
+
+
+(deffoo nnvirtual-request-group (group &optional server dont-check)
+ (nnvirtual-possibly-change-server server)
+ (setq nnvirtual-component-groups
+ (delete (nnvirtual-current-group) nnvirtual-component-groups))
+ (cond
+ ((null nnvirtual-component-groups)
+ (setq nnvirtual-current-group nil)
+ (nnheader-report 'nnvirtual "No component groups in %s" group))
+ (t
+ (when (or (not dont-check)
+ nnvirtual-always-rescan)
+ (nnvirtual-create-mapping))
+ (setq nnvirtual-current-group group)
+ (nnheader-insert "211 %d 1 %d %s\n"
+ nnvirtual-mapping-len nnvirtual-mapping-len group))))
+
+
+(deffoo nnvirtual-request-type (group &optional article)
+ (if (not article)
+ 'unknown
+ (let ((mart (nnvirtual-map-article article)))
+ (when mart
+ (gnus-request-type (car mart) (cdr mart))))))
+
+(deffoo nnvirtual-request-update-mark (group article mark)
+ (let* ((nart (nnvirtual-map-article article))
+ (cgroup (car nart))
+ ;; The component group might be a virtual group.
+ (nmark (gnus-request-update-mark cgroup (cdr nart) mark)))
+ (when (and nart
+ (= mark nmark)
+ (gnus-group-auto-expirable-p cgroup))
+ (setq mark gnus-expirable-mark)))
+ mark)
+
+
+(deffoo nnvirtual-close-group (group &optional server)
+ (when (and (nnvirtual-possibly-change-server server)
+ (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
+ (nnvirtual-update-read-and-marked t t))
+ t)
+
+
+(deffoo nnvirtual-request-list (&optional server)
+ (nnheader-report 'nnvirtual "LIST is not implemented."))
+
+
+(deffoo nnvirtual-request-newgroups (date &optional server)
+ (nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
+
+
+(deffoo nnvirtual-request-list-newsgroups (&optional server)
+ (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented."))
+
+
+(deffoo nnvirtual-request-update-info (group info &optional server)
+ (when (and (nnvirtual-possibly-change-server server)
+ (not nnvirtual-info-installed))
+ ;; Install the precomputed lists atomically, so the virtual group
+ ;; is not left in a half-way state in case of C-g.
+ (gnus-atomic-progn
+ (setcar (cddr info) nnvirtual-mapping-reads)
+ (if (nthcdr 3 info)
+ (setcar (nthcdr 3 info) nnvirtual-mapping-marks)
+ (when nnvirtual-mapping-marks
+ (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks))))
+ (setq nnvirtual-info-installed t))
+ t))
+
+
+(deffoo nnvirtual-catchup-group (group &optional server all)
+ (when (and (nnvirtual-possibly-change-server server)
+ (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
+ ;; copy over existing marks first, in case they set anything
+ (nnvirtual-update-read-and-marked nil nil)
+ ;; do a catchup on all component groups
+ (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
+ (gnus-expert-user t))
+ ;; Make sure all groups are activated.
+ (mapcar
+ (lambda (g)
+ (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
+ (gnus-activate-group g)))
+ nnvirtual-component-groups)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-group-catchup-current nil all)))))
+
+
+(deffoo nnvirtual-find-group-art (group article)
+ "Return the real group and article for virtual GROUP and ARTICLE."
+ (nnvirtual-map-article article))
+
+
+(deffoo nnvirtual-request-post (&optional server)
+ (if (not gnus-message-group-art)
+ (nnheader-report 'nnvirtual "Can't post to an nnvirtual group")
+ (let ((group (car (nnvirtual-find-group-art
+ (car gnus-message-group-art)
+ (cdr gnus-message-group-art)))))
+ (gnus-request-post (gnus-find-method-for-group group)))))
+
+\f
+;;; Internal functions.
+
+(defun nnvirtual-convert-headers ()
+ "Convert HEAD headers into NOV headers."
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let* ((dependencies (make-vector 100 0))
+ (headers (gnus-get-newsgroup-headers dependencies))
+ header)
+ (erase-buffer)
+ (while (setq header (pop headers))
+ (nnheader-insert-nov header)))))
+
+
+(defun nnvirtual-update-xref-header (group article prefix system-name)
+ "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines."
+ ;; Move to beginning of Xref field, creating a slot if needed.
+ (beginning-of-line)
+ (looking-at
+ "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
+ (goto-char (match-end 0))
+ (unless (search-forward "\t" (gnus-point-at-eol) 'move)
+ (insert "\t"))
+
+ ;; Remove any spaces at the beginning of the Xref field.
+ (while (= (char-after (1- (point))) ? )
+ (forward-char -1)
+ (delete-char 1))
+
+ (insert "Xref: " system-name " " group ":")
+ (princ article (current-buffer))
+ (insert " ")
+
+ ;; If there were existing xref lines, clean them up to have the correct
+ ;; component server prefix.
+ (save-restriction
+ (narrow-to-region (point)
+ (or (search-forward "\t" (gnus-point-at-eol) t)
+ (gnus-point-at-eol)))
+ (goto-char (point-min))
+ (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
+ (replace-match "" t t))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat (gnus-group-real-name group) ":[0-9]+")
+ nil t)
+ (replace-match "" t t))
+ (unless (= (point) (point-max))
+ (insert " ")
+ (when (not (string= "" prefix))
+ (while (re-search-forward "[^ ]+:[0-9]+" nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (insert prefix))))))
+
+ ;; Ensure a trailing \t.
+ (end-of-line)
+ (or (= (char-after (1- (point))) ?\t)
+ (insert ?\t)))
+
+
+(defun nnvirtual-possibly-change-server (server)
+ (or (not server)
+ (nnoo-current-server-p 'nnvirtual server)
+ (nnvirtual-open-server server)))
+
+
+(defun nnvirtual-update-read-and-marked (read-p update-p)
+ "Copy marks from the virtual group to the component groups.
+If READ-P is not nil, update the (un)read status of the components.
+If UPDATE-P is not nil, call gnus-group-update-group on the components."
+ (when nnvirtual-current-group
+ (let ((unreads (and read-p
+ (nnvirtual-partition-sequence
+ (gnus-list-of-unread-articles
+ (nnvirtual-current-group)))))
+ (type-marks (mapcar (lambda (ml)
+ (cons (car ml)
+ (nnvirtual-partition-sequence (cdr ml))))
+ (gnus-info-marks (gnus-get-info
+ (nnvirtual-current-group)))))
+ mark type groups carticles info entry)
+
+ ;; Ok, atomically move all of the (un)read info, clear any old
+ ;; marks, and move all of the current marks. This way if someone
+ ;; hits C-g, you won't leave the component groups in a half-way state.
+ (gnus-atomic-progn
+ ;; move (un)read
+ (let ((gnus-newsgroup-active nil)) ;workaround guns-update-read-articles
+ (while (setq entry (pop unreads))
+ (gnus-update-read-articles (car entry) (cdr entry))))
+
+ ;; clear all existing marks on the component groups
+ (setq groups nnvirtual-component-groups)
+ (while groups
+ (when (and (setq info (gnus-get-info (pop groups)))
+ (gnus-info-marks info))
+ (gnus-info-set-marks info nil)))
+
+ ;; Ok, currently type-marks is an assq list with keys of a mark type,
+ ;; with data of an assq list with keys of component group names
+ ;; and the articles which correspond to that key/group pair.
+ (while (setq mark (pop type-marks))
+ (setq type (car mark))
+ (setq groups (cdr mark))
+ (while (setq carticles (pop groups))
+ (gnus-add-marked-articles (car carticles) type (cdr carticles)
+ nil t))))
+
+ ;; possibly update the display, it is really slow
+ (when update-p
+ (setq groups nnvirtual-component-groups)
+ (while groups
+ (gnus-group-update-group (pop groups) t))))))
+
+
+(defun nnvirtual-current-group ()
+ "Return the prefixed name of the current nnvirtual group."
+ (concat "nnvirtual:" nnvirtual-current-group))
+
+
+
+;;; This is currently O(kn^2) to merge n lists of length k.
+;;; You could do it in O(knlogn), but we have a small n, and the
+;;; overhead of the other approach is probably greater.
+(defun nnvirtual-merge-sorted-lists (&rest lists)
+ "Merge many sorted lists of numbers."
+ (if (null (cdr lists))
+ (car lists)
+ (sort (apply 'nconc lists) '<)))
+
+
+;;; We map between virtual articles and real articles in a manner
+;;; which keeps the size of the virtual active list the same as
+;;; the sum of the component active lists.
+;;; To achieve fair mixing of the groups, the last article in
+;;; each of N component groups will be in the the last N articles
+;;; in the virtual group.
+
+;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7
+;;; resprectively, then the virtual article numbers look like:
+;;;
+;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7
+
+;;; To compute these mappings we generate a couple tables and then
+;;; do some fast operations on them. Tables for the example above:
+;;;
+;;; Offsets - [(A 0) (B -3) (C -1)]
+;;;
+;;; a b c d e
+;;; Mapping - ([ 3 0 1 3 0 ]
+;;; [ 6 3 2 9 3 ]
+;;; [ 8 6 3 15 9 ])
+;;;
+;;; (note column 'e' is different in real algorithm, which is slightly
+;;; different than described here, but this gives you the methodology.)
+;;;
+;;; The basic idea is this, when going from component->virtual, apply
+;;; the appropriate offset to the article number. Then search the first
+;;; column of the table for a row where 'a' is less than or equal to the
+;;; modified number. You can see that only group A can therefore go to
+;;; the first row, groups A and B to the second, and all to the last.
+;;; The third column of the table is telling us the number of groups
+;;; which might be able to reach that row (it might increase by more than
+;;; 1 if several groups have the same size).
+;;; Then column 'b' provides an additional offset you apply when you have
+;;; found the correct row. You then multiply by 'c' and add on the groups
+;;; _position_ in the offset table. The basic idea here is that on
+;;; any given row we are going to map back and forth using X'=X*c+Y and
+;;; X=(X'/c), Y=(X' mod c). Then once you've done this transformation,
+;;; you apply a final offset from column 'e' to give the virtual article.
+;;;
+;;; Going the other direction, you instead search on column 'd' instead
+;;; of 'a', and apply everything in reverse order.
+
+;;; Convert component -> virtual:
+;;; set num = num - Offset(group)
+;;; find first row in Mapping where num <= 'a'
+;;; num = (num-'b')*c + Position(group) + 'e'
+
+;;; Convert virtual -> component:
+;;; find first row in Mapping where num <= 'd'
+;;; num = num - 'e'
+;;; group_pos = num mod 'c'
+;;; num = (num / 'c') + 'b' + Offset(group_pos)
+
+;;; Easy no? :)
+;;;
+;;; Well actually, you need to keep column e offset smaller by the 'c'
+;;; column for that line, and always add 1 more when going from
+;;; component -> virtual. Otherwise you run into a problem with
+;;; unique reverse mapping.
+
+(defun nnvirtual-map-article (article)
+ "Return a cons of the component group and article corresponding to the given virtual ARTICLE."
+ (let ((table nnvirtual-mapping-table)
+ entry group-pos)
+ (while (and table
+ (> article (aref (car table) 3)))
+ (setq table (cdr table)))
+ (when (and table
+ (> article 0))
+ (setq entry (car table))
+ (setq article (- article (aref entry 4) 1))
+ (setq group-pos (mod article (aref entry 2)))
+ (cons (car (aref nnvirtual-mapping-offsets group-pos))
+ (+ (/ article (aref entry 2))
+ (aref entry 1)
+ (cdr (aref nnvirtual-mapping-offsets group-pos)))
+ ))
+ ))
+
+
+
+(defun nnvirtual-reverse-map-article (group article)
+ "Return the virtual article number corresponding to the given component GROUP and ARTICLE."
+ (when (numberp article)
+ (let ((table nnvirtual-mapping-table)
+ (group-pos 0)
+ entry)
+ (while (not (string= group (car (aref nnvirtual-mapping-offsets
+ group-pos))))
+ (setq group-pos (1+ group-pos)))
+ (setq article (- article (cdr (aref nnvirtual-mapping-offsets
+ group-pos))))
+ (while (and table
+ (> article (aref (car table) 0)))
+ (setq table (cdr table)))
+ (setq entry (car table))
+ (when (and entry
+ (> article 0)
+ (< group-pos (aref entry 2))) ; article not out of range below
+ (+ (aref entry 4)
+ group-pos
+ (* (- article (aref entry 1))
+ (aref entry 2))
+ 1))
+ )))
+
+
+(defsubst nnvirtual-reverse-map-sequence (group articles)
+ "Return list of virtual article numbers for all ARTICLES in GROUP.
+The ARTICLES should be sorted, and can be a compressed sequence.
+If any of the article numbers has no corresponding virtual article,
+then it is left out of the result."
+ (when (numberp (cdr-safe articles))
+ (setq articles (list articles)))
+ (let (result a i j new-a)
+ (while (setq a (pop articles))
+ (if (atom a)
+ (setq i a
+ j a)
+ (setq i (car a)
+ j (cdr a)))
+ (while (<= i j)
+ ;; If this is slow, you can optimize by moving article checking
+ ;; into here. You don't have to recompute the group-pos,
+ ;; nor scan the table every time.
+ (when (setq new-a (nnvirtual-reverse-map-article group i))
+ (push new-a result))
+ (setq i (1+ i))))
+ (nreverse result)))
+
+
+(defun nnvirtual-partition-sequence (articles)
+ "Return an association list of component article numbers.
+These are indexed by elements of nnvirtual-component-groups, based on
+the sequence ARTICLES of virtual article numbers. ARTICLES should be
+sorted, and can be a compressed sequence. If any of the article
+numbers has no corresponding component article, then it is left out of
+the result."
+ (when (numberp (cdr-safe articles))
+ (setq articles (list articles)))
+ (let ((carticles (mapcar (lambda (g) (list g))
+ nnvirtual-component-groups))
+ a i j article entry)
+ (while (setq a (pop articles))
+ (if (atom a)
+ (setq i a
+ j a)
+ (setq i (car a)
+ j (cdr a)))
+ (while (<= i j)
+ (when (setq article (nnvirtual-map-article i))
+ (setq entry (assoc (car article) carticles))
+ (setcdr entry (cons (cdr article) (cdr entry))))
+ (setq i (1+ i))))
+ (mapcar (lambda (x) (setcdr x (nreverse (cdr x))))
+ carticles)
+ carticles))
+
+
+(defun nnvirtual-create-mapping ()
+ "Build the tables necessary to map between component (group, article) to virtual article.
+Generate the set of read messages and marks for the virtual group
+based on the marks on the component groups."
+ (let ((cnt 0)
+ (tot 0)
+ (M 0)
+ (i 0)
+ actives all-unreads all-marks
+ active min max size unreads marks
+ next-M next-tot
+ reads beg)
+ ;; Ok, we loop over all component groups and collect a lot of
+ ;; information:
+ ;; Into actives we place (g size max), where size is max-min+1.
+ ;; Into all-unreads we put (g unreads).
+ ;; Into all-marks we put (g marks).
+ ;; We also increment cnt and tot here, and compute M (max of sizes).
+ (mapc (lambda (g)
+ (setq active (gnus-activate-group g)
+ min (car active)
+ max (cdr active))
+ (when (and active (>= max min) (not (zerop max)))
+ ;; store active information
+ (push (list g (- max min -1) max) actives)
+ ;; collect unread/mark info for later
+ (setq unreads (gnus-list-of-unread-articles g))
+ (setq marks (gnus-info-marks (gnus-get-info g)))
+ (when gnus-use-cache
+ (push (cons 'cache
+ (gnus-cache-articles-in-group g))
+ marks))
+ (push (cons g unreads) all-unreads)
+ (push (cons g marks) all-marks)
+ ;; count groups, total #articles, and max size
+ (setq size (- max min -1))
+ (setq cnt (1+ cnt)
+ tot (+ tot size)
+ M (max M size))))
+ nnvirtual-component-groups)
+
+ ;; Number of articles in the virtual group.
+ (setq nnvirtual-mapping-len tot)
+
+
+ ;; We want the actives list sorted by size, to build the tables.
+ (setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2)))))
+
+ ;; Build the offset table. Largest sized groups are at the front.
+ (setq nnvirtual-mapping-offsets
+ (vconcat
+ (nreverse
+ (mapcar (lambda (entry)
+ (cons (nth 0 entry)
+ (- (nth 2 entry) M)))
+ actives))))
+
+ ;; Build the mapping table.
+ (setq nnvirtual-mapping-table nil)
+ (setq actives (mapcar (lambda (entry) (nth 1 entry)) actives))
+ (while actives
+ (setq size (car actives))
+ (setq next-M (- M size))
+ (setq next-tot (- tot (* cnt size)))
+ ;; make current row in table
+ (push (vector M next-M cnt tot (- next-tot cnt))
+ nnvirtual-mapping-table)
+ ;; update M and tot
+ (setq M next-M)
+ (setq tot next-tot)
+ ;; subtract the current size from all entries.
+ (setq actives (mapcar (lambda (x) (- x size)) actives))
+ ;; remove anything that went to 0.
+ (while (and actives
+ (= (car actives) 0))
+ (pop actives)
+ (setq cnt (- cnt 1))))
+
+
+ ;; Now that the mapping tables are generated, we can convert
+ ;; and combine the separate component unreads and marks lists
+ ;; into single lists of virtual article numbers.
+ (setq unreads (apply 'nnvirtual-merge-sorted-lists
+ (mapcar (lambda (x)
+ (nnvirtual-reverse-map-sequence
+ (car x) (cdr x)))
+ all-unreads)))
+ (setq marks (mapcar
+ (lambda (type)
+ (cons (cdr type)
+ (gnus-compress-sequence
+ (apply
+ 'nnvirtual-merge-sorted-lists
+ (mapcar (lambda (x)
+ (nnvirtual-reverse-map-sequence
+ (car x)
+ (cdr (assq (cdr type) (cdr x)))))
+ all-marks)))))
+ gnus-article-mark-lists))
+
+ ;; Remove any empty marks lists, and store.
+ (setq nnvirtual-mapping-marks nil)
+ (while marks
+ (if (cdr (car marks))
+ (push (car marks) nnvirtual-mapping-marks))
+ (setq marks (cdr marks)))
+
+ ;; We need to convert the unreads to reads. We compress the
+ ;; sequence as we go, otherwise it could be huge.
+ (while (and (<= (incf i) nnvirtual-mapping-len)
+ unreads)
+ (if (= i (car unreads))
+ (setq unreads (cdr unreads))
+ ;; try to get a range.
+ (setq beg i)
+ (while (and (<= (incf i) nnvirtual-mapping-len)
+ (not (= i (car unreads)))))
+ (setq i (- i 1))
+ (if (= i beg)
+ (push i reads)
+ (push (cons beg i) reads))
+ ))
+ (when (<= i nnvirtual-mapping-len)
+ (if (= i nnvirtual-mapping-len)
+ (push i reads)
+ (push (cons i nnvirtual-mapping-len) reads)))
+
+ ;; Store the reads list for later use.
+ (setq nnvirtual-mapping-reads (nreverse reads))
+
+ ;; Throw flag to show we changed the info.
+ (setq nnvirtual-info-installed nil)
+ ))
+
+(provide 'nnvirtual)
+
+;;; nnvirtual.el ends here
--- /dev/null
+;;; nnweb.el --- retrieving articles via web search engines
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Note: You need to have `url' and `w3' installed for this
+;; backend to work.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'nnoo)
+(require 'message)
+(require 'gnus-util)
+(require 'gnus)
+(require 'w3)
+(require 'url)
+(require 'nnmail)
+(ignore-errors
+ (require 'w3-forms))
+
+(nnoo-declare nnweb)
+
+(defvoo nnweb-directory (nnheader-concat gnus-directory "nnweb/")
+ "Where nnweb will save its files.")
+
+(defvoo nnweb-type 'dejanews
+ "What search engine type is being used.")
+
+(defvar nnweb-type-definition
+ '((dejanews
+ (article . nnweb-dejanews-wash-article)
+ (map . nnweb-dejanews-create-mapping)
+ (search . nnweb-dejanews-search)
+ (address . "http://xp9.dejanews.com/dnquery.xp")
+ (identifier . nnweb-dejanews-identity))
+ (reference
+ (article . nnweb-reference-wash-article)
+ (map . nnweb-reference-create-mapping)
+ (search . nnweb-reference-search)
+ (address . "http://www.reference.com/cgi-bin/pn/go")
+ (identifier . identity))
+ (altavista
+ (article . nnweb-altavista-wash-article)
+ (map . nnweb-altavista-create-mapping)
+ (search . nnweb-altavista-search)
+ (address . "http://www.altavista.digital.com/cgi-bin/query")
+ (id . "/cgi-bin/news?id@%s")
+ (identifier . identity)))
+ "Type-definition alist.")
+
+(defvoo nnweb-search nil
+ "Search string to feed to DejaNews.")
+
+(defvoo nnweb-max-hits 100
+ "Maximum number of hits to display.")
+
+(defvoo nnweb-ephemeral-p nil
+ "Whether this nnweb server is ephemeral.")
+
+;;; Internal variables
+
+(defvoo nnweb-articles nil)
+(defvoo nnweb-buffer nil)
+(defvoo nnweb-group-alist nil)
+(defvoo nnweb-group nil)
+(defvoo nnweb-hashtb nil)
+
+;;; Interface functions
+
+(nnoo-define-basics nnweb)
+
+(deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
+ (nnweb-possibly-change-server group server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let (article header)
+ (while (setq article (pop articles))
+ (when (setq header (cadr (assq article nnweb-articles)))
+ (nnheader-insert-nov header)))
+ 'nov)))
+
+(deffoo nnweb-request-scan (&optional group server)
+ (nnweb-possibly-change-server group server)
+ (setq nnweb-hashtb (gnus-make-hashtable 4095))
+ (funcall (nnweb-definition 'map))
+ (unless nnweb-ephemeral-p
+ (nnweb-write-active)
+ (nnweb-write-overview group)))
+
+(deffoo nnweb-request-group (group &optional server dont-check)
+ (nnweb-possibly-change-server nil server)
+ (when (and group
+ (not (equal group nnweb-group))
+ (not nnweb-ephemeral-p))
+ (let ((info (assoc group nnweb-group-alist)))
+ (setq nnweb-group group)
+ (setq nnweb-type (nth 2 info))
+ (setq nnweb-search (nth 3 info))
+ (unless dont-check
+ (nnweb-read-overview group))))
+ (cond
+ ((not nnweb-articles)
+ (nnheader-report 'nnweb "No matching articles"))
+ (t
+ (let ((active (if nnweb-ephemeral-p
+ (cons (caar nnweb-articles)
+ (caar (last nnweb-articles)))
+ (cadr (assoc group nnweb-group-alist)))))
+ (nnheader-report 'nnweb "Opened group %s" group)
+ (nnheader-insert
+ "211 %d %d %d %s\n" (length nnweb-articles)
+ (car active) (cdr active) group)))))
+
+(deffoo nnweb-close-group (group &optional server)
+ (nnweb-possibly-change-server group server)
+ (when (gnus-buffer-live-p nnweb-buffer)
+ (save-excursion
+ (set-buffer nnweb-buffer)
+ (set-buffer-modified-p nil)
+ (kill-buffer nnweb-buffer)))
+ t)
+
+(deffoo nnweb-request-article (article &optional group server buffer)
+ (nnweb-possibly-change-server group server)
+ (save-excursion
+ (set-buffer (or buffer nntp-server-buffer))
+ (let* ((header (cadr (assq article nnweb-articles)))
+ (url (and header (mail-header-xref header))))
+ (when (or (and url
+ (nnweb-fetch-url url))
+ (and (stringp article)
+ (nnweb-definition 'id t)
+ (let ((fetch (nnweb-definition 'id))
+ art)
+ (when (string-match "^<\\(.*\\)>$" article)
+ (setq art (match-string 1 article)))
+ (and fetch
+ art
+ (nnweb-fetch-url
+ (format fetch article))))))
+ (unless nnheader-callback-function
+ (funcall (nnweb-definition 'article))
+ (nnweb-decode-entities))
+ (nnheader-report 'nnweb "Fetched article %s" article)
+ t))))
+
+(deffoo nnweb-close-server (&optional server)
+ (when (and (nnweb-server-opened server)
+ (gnus-buffer-live-p nnweb-buffer))
+ (save-excursion
+ (set-buffer nnweb-buffer)
+ (set-buffer-modified-p nil)
+ (kill-buffer nnweb-buffer)))
+ (nnoo-close-server 'nnweb server))
+
+(deffoo nnweb-request-list (&optional server)
+ (nnweb-possibly-change-server nil server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (nnmail-generate-active nnweb-group-alist)
+ t))
+
+(deffoo nnweb-request-update-info (group info &optional server)
+ (nnweb-possibly-change-server group server)
+ ;;(setcar (cddr info) nil)
+ )
+
+(deffoo nnweb-asynchronous-p ()
+ t)
+
+(deffoo nnweb-request-create-group (group &optional server args)
+ (nnweb-possibly-change-server nil server)
+ (nnweb-request-delete-group group)
+ (push `(,group ,(cons 1 0) ,@args) nnweb-group-alist)
+ (nnweb-write-active)
+ t)
+
+(deffoo nnweb-request-delete-group (group &optional force server)
+ (nnweb-possibly-change-server group server)
+ (gnus-delete-assoc group nnweb-group-alist)
+ (gnus-delete-file (nnweb-overview-file group))
+ t)
+
+(nnoo-define-skeleton nnweb)
+
+;;; Internal functions
+
+(defun nnweb-read-overview (group)
+ "Read the overview of GROUP and build the map."
+ (when (file-exists-p (nnweb-overview-file group))
+ (nnheader-temp-write nil
+ (nnheader-insert-file-contents (nnweb-overview-file group))
+ (goto-char (point-min))
+ (let (header)
+ (while (not (eobp))
+ (setq header (nnheader-parse-nov))
+ (forward-line 1)
+ (push (list (mail-header-number header)
+ header (mail-header-xref header))
+ nnweb-articles)
+ (nnweb-set-hashtb header (car nnweb-articles)))))))
+
+(defun nnweb-write-overview (group)
+ "Write the overview file for GROUP."
+ (nnheader-temp-write (nnweb-overview-file group)
+ (let ((articles nnweb-articles))
+ (while articles
+ (nnheader-insert-nov (cadr (pop articles)))))))
+
+(defun nnweb-set-hashtb (header data)
+ (gnus-sethash (nnweb-identifier (mail-header-xref header))
+ data nnweb-hashtb))
+
+(defun nnweb-get-hashtb (url)
+ (gnus-gethash (nnweb-identifier url) nnweb-hashtb))
+
+(defun nnweb-identifier (ident)
+ (funcall (nnweb-definition 'identifier) ident))
+
+(defun nnweb-overview-file (group)
+ "Return the name of the overview file of GROUP."
+ (nnheader-concat nnweb-directory group ".overview"))
+
+(defun nnweb-write-active ()
+ "Save the active file."
+ (nnheader-temp-write (nnheader-concat nnweb-directory "active")
+ (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))
+
+(defun nnweb-read-active ()
+ "Read the active file."
+ (load (nnheader-concat nnweb-directory "active") t t t))
+
+(defun nnweb-definition (type &optional noerror)
+ "Return the definition of TYPE."
+ (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition)))))
+ (when (and (not def)
+ (not noerror))
+ (error "Undefined definition %s" type))
+ def))
+
+(defun nnweb-possibly-change-server (&optional group server)
+ (nnweb-init server)
+ (when server
+ (unless (nnweb-server-opened server)
+ (nnweb-open-server server)))
+ (unless nnweb-group-alist
+ (nnweb-read-active))
+ (when group
+ (when (and (not nnweb-ephemeral-p)
+ (not (equal group nnweb-group)))
+ (nnweb-request-group group nil t))))
+
+(defun nnweb-init (server)
+ "Initialize buffers and such."
+ (unless (gnus-buffer-live-p nnweb-buffer)
+ (setq nnweb-buffer
+ (save-excursion
+ (nnheader-set-temp-buffer
+ (format " *nnweb %s %s %s*" nnweb-type nnweb-search server))))))
+
+(defun nnweb-fetch-url (url)
+ (save-excursion
+ (if (not nnheader-callback-function)
+ (let ((buf (current-buffer)))
+ (save-excursion
+ (set-buffer nnweb-buffer)
+ (erase-buffer)
+ (url-insert-file-contents url)
+ (copy-to-buffer buf (point-min) (point-max))
+ t))
+ (nnweb-url-retrieve-asynch
+ url 'nnweb-callback (current-buffer) nnheader-callback-function)
+ t)))
+
+(defun nnweb-callback (buffer callback)
+ (when (gnus-buffer-live-p url-working-buffer)
+ (save-excursion
+ (set-buffer url-working-buffer)
+ (funcall (nnweb-definition 'article))
+ (nnweb-decode-entities)
+ (set-buffer buffer)
+ (goto-char (point-max))
+ (insert-buffer-substring url-working-buffer))
+ (funcall callback t)
+ (gnus-kill-buffer url-working-buffer)))
+
+(defun nnweb-url-retrieve-asynch (url callback &rest data)
+ (let ((url-request-method "GET")
+ (old-asynch url-be-asynchronous)
+ (url-request-data nil)
+ (url-request-extra-headers nil)
+ (url-working-buffer (generate-new-buffer-name " *nnweb*")))
+ (setq-default url-be-asynchronous t)
+ (save-excursion
+ (set-buffer (get-buffer-create url-working-buffer))
+ (setq url-current-callback-data data
+ url-be-asynchronous t
+ url-current-callback-func callback)
+ (url-retrieve url))
+ (setq-default url-be-asynchronous old-asynch)))
+
+(defun nnweb-encode-www-form-urlencoded (pairs)
+ "Return PAIRS encoded for forms."
+ (mapconcat
+ (function
+ (lambda (data)
+ (concat (w3-form-encode-xwfu (car data)) "="
+ (w3-form-encode-xwfu (cdr data)))))
+ pairs "&"))
+
+(defun nnweb-fetch-form (url pairs)
+ (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
+ (url-request-method "POST")
+ (url-request-extra-headers
+ '(("Content-type" . "application/x-www-form-urlencoded"))))
+ (url-insert-file-contents url)
+ (setq buffer-file-name nil))
+ t)
+
+(defun nnweb-decode-entities ()
+ (goto-char (point-min))
+ (while (re-search-forward "&\\([a-z]+\\);" nil t)
+ (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
+ w3-html-entities))
+ ?#))
+ t t)))
+
+(defun nnweb-remove-markup ()
+ (goto-char (point-min))
+ (while (search-forward "<!--" nil t)
+ (delete-region (match-beginning 0)
+ (or (search-forward "-->" nil t)
+ (point-max))))
+ (goto-char (point-min))
+ (while (re-search-forward "<[^>]+>" nil t)
+ (replace-match "" t t)))
+
+;;;
+;;; DejaNews functions.
+;;;
+
+(defun nnweb-dejanews-create-mapping ()
+ "Perform the search and create an number-to-url alist."
+ (save-excursion
+ (set-buffer nnweb-buffer)
+ (erase-buffer)
+ (when (funcall (nnweb-definition 'search) nnweb-search)
+ (let ((i 0)
+ (more t)
+ (case-fold-search t)
+ (active (or (cadr (assoc nnweb-group nnweb-group-alist))
+ (cons 1 0)))
+ Subject Score Date Newsgroup Author
+ map url)
+ (while more
+ ;; Go through all the article hits on this page.
+ (goto-char (point-min))
+ (nnweb-decode-entities)
+ (goto-char (point-min))
+ (while (re-search-forward "^ +[0-9]+\\." nil t)
+ (narrow-to-region
+ (point)
+ (cond ((re-search-forward "^ +[0-9]+\\." nil t)
+ (match-beginning 0))
+ ((search-forward "\n\n" nil t)
+ (point))
+ (t
+ (point-max))))
+ (goto-char (point-min))
+ (when (looking-at ".*HREF=\"\\([^\"]+\\)\"")
+ (setq url (match-string 1)))
+ (nnweb-remove-markup)
+ (goto-char (point-min))
+ (while (search-forward "\t" nil t)
+ (replace-match " "))
+ (goto-char (point-min))
+ (while (re-search-forward "^ +\\([^:]+\\): +\\(.*\\)$" nil t)
+ (set (intern (match-string 1)) (match-string 2)))
+ (widen)
+ (when (string-match "#[0-9]+/[0-9]+ *$" Subject)
+ (setq Subject (substring Subject 0 (match-beginning 0))))
+ (incf i)
+ (unless (nnweb-get-hashtb url)
+ (push
+ (list
+ (incf (cdr active))
+ (make-full-mail-header
+ (cdr active) (concat "(" Newsgroup ") " Subject) Author Date
+ (concat "<" (nnweb-identifier url) "@dejanews>")
+ nil 0 (string-to-int Score) url))
+ map)
+ (nnweb-set-hashtb (cadar map) (car map))))
+ ;; See whether there is a "Get next 20 hits" button here.
+ (if (or (not (re-search-forward
+ "HREF=\"\\([^\"]+\\)\">Get next" nil t))
+ (>= i nnweb-max-hits))
+ (setq more nil)
+ ;; Yup -- fetch it.
+ (setq more (match-string 1))
+ (erase-buffer)
+ (url-insert-file-contents more)))
+ ;; Return the articles in the right order.
+ (setq nnweb-articles
+ (sort (nconc nnweb-articles map) 'car-less-than-car))))))
+
+(defun nnweb-dejanews-wash-article ()
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (re-search-forward "<PRE>" nil t)
+ (delete-region (point-min) (point))
+ (re-search-forward "</PRE>" nil t)
+ (delete-region (point) (point-max))
+ (nnweb-remove-markup)
+ (goto-char (point-min))
+ (while (and (looking-at " *$")
+ (not (eobp)))
+ (gnus-delete-line))
+ (while (looking-at "\\(^[^ ]+:\\) *")
+ (replace-match "\\1 " t)
+ (forward-line 1))
+ (when (re-search-forward "\n\n+" nil t)
+ (replace-match "\n" t t))
+ (goto-char (point-min))
+ (when (search-forward "[More Headers]" nil t)
+ (replace-match "" t t))))
+
+(defun nnweb-dejanews-search (search)
+ (nnweb-fetch-form
+ (nnweb-definition 'address)
+ `(("query" . ,search)
+ ("defaultOp" . "AND")
+ ("svcclass" . "dncurrent")
+ ("maxhits" . "100")
+ ("format" . "verbose")
+ ("threaded" . "0")
+ ("showsort" . "score")
+ ("agesign" . "1")
+ ("ageweight" . "1")))
+ t)
+
+(defun nnweb-dejanews-identity (url)
+ "Return an unique identifier based on URL."
+ (if (string-match "recnum=\\([0-9]+\\)" url)
+ (match-string 1 url)
+ url))
+
+;;;
+;;; InReference
+;;;
+
+(defun nnweb-reference-create-mapping ()
+ "Perform the search and create an number-to-url alist."
+ (save-excursion
+ (set-buffer nnweb-buffer)
+ (erase-buffer)
+ (when (funcall (nnweb-definition 'search) nnweb-search)
+ (let ((i 0)
+ (more t)
+ (case-fold-search t)
+ (active (or (cadr (assoc nnweb-group nnweb-group-alist))
+ (cons 1 0)))
+ Subject Score Date Newsgroups From Message-ID
+ map url)
+ (while more
+ ;; Go through all the article hits on this page.
+ (goto-char (point-min))
+ (search-forward "</pre><hr>" nil t)
+ (delete-region (point-min) (point))
+ ;(nnweb-decode-entities)
+ (goto-char (point-min))
+ (while (re-search-forward "^ +[0-9]+\\." nil t)
+ (narrow-to-region
+ (point)
+ (if (re-search-forward "^$" nil t)
+ (match-beginning 0)
+ (point-max)))
+ (goto-char (point-min))
+ (when (looking-at ".*href=\"\\([^\"]+\\)\"")
+ (setq url (match-string 1)))
+ (nnweb-remove-markup)
+ (goto-char (point-min))
+ (while (search-forward "\t" nil t)
+ (replace-match " "))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([^:]+\\): \\(.*\\)$" nil t)
+ (set (intern (match-string 1)) (match-string 2)))
+ (widen)
+ (search-forward "</pre>" nil t)
+ (incf i)
+ (unless (nnweb-get-hashtb url)
+ (push
+ (list
+ (incf (cdr active))
+ (make-full-mail-header
+ (cdr active) (concat "(" Newsgroups ") " Subject) From Date
+ Message-ID
+ nil 0 (string-to-int Score) url))
+ map)
+ (nnweb-set-hashtb (cadar map) (car map))))
+ (setq more nil))
+ ;; Return the articles in the right order.
+ (setq nnweb-articles
+ (sort (nconc nnweb-articles map) 'car-less-than-car))))))
+
+(defun nnweb-reference-wash-article ()
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (re-search-forward "^</center><hr>" nil t)
+ (delete-region (point-min) (point))
+ (search-forward "<pre>" nil t)
+ (forward-line -1)
+ (let ((body (point-marker)))
+ (search-forward "</pre>" nil t)
+ (delete-region (point) (point-max))
+ (nnweb-remove-markup)
+ (goto-char (point-min))
+ (while (looking-at " *$")
+ (gnus-delete-line))
+ (narrow-to-region (point-min) body)
+ (while (and (re-search-forward "^$" nil t)
+ (not (eobp)))
+ (gnus-delete-line))
+ (goto-char (point-min))
+ (while (looking-at "\\(^[^ ]+:\\) *")
+ (replace-match "\\1 " t)
+ (forward-line 1))
+ (goto-char (point-min))
+ (when (re-search-forward "^References:" nil t)
+ (narrow-to-region
+ (point) (if (re-search-forward "^$\\|^[^:]+:" nil t)
+ (match-beginning 0)
+ (point-max)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (looking-at "References")
+ (insert "\t")
+ (forward-line 1)))
+ (goto-char (point-min))
+ (while (search-forward "," nil t)
+ (replace-match " " t t)))
+ (widen)
+ (set-marker body nil))))
+
+(defun nnweb-reference-search (search)
+ (url-insert-file-contents
+ (concat
+ (nnweb-definition 'address)
+ "?"
+ (nnweb-encode-www-form-urlencoded
+ `(("search" . "advanced")
+ ("querytext" . ,search)
+ ("subj" . "")
+ ("name" . "")
+ ("login" . "")
+ ("host" . "")
+ ("organization" . "")
+ ("groups" . "")
+ ("keywords" . "")
+ ("choice" . "Search")
+ ("startmonth" . "Jul")
+ ("startday" . "25")
+ ("startyear" . "1996")
+ ("endmonth" . "Aug")
+ ("endday" . "24")
+ ("endyear" . "1996")
+ ("mode" . "Quick")
+ ("verbosity" . "Verbose")
+ ("ranking" . "Relevance")
+ ("first" . "1")
+ ("last" . "25")
+ ("score" . "50")))))
+ (setq buffer-file-name nil)
+ t)
+
+;;;
+;;; Alta Vista
+;;;
+
+(defun nnweb-altavista-create-mapping ()
+ "Perform the search and create an number-to-url alist."
+ (save-excursion
+ (set-buffer nnweb-buffer)
+ (erase-buffer)
+ (let ((part 0))
+ (when (funcall (nnweb-definition 'search) nnweb-search part)
+ (let ((i 0)
+ (more t)
+ (case-fold-search t)
+ (active (or (cadr (assoc nnweb-group nnweb-group-alist))
+ (cons 1 0)))
+ subject date from id group
+ map url)
+ (while more
+ ;; Go through all the article hits on this page.
+ (goto-char (point-min))
+ (search-forward "<dt>" nil t)
+ (delete-region (point-min) (match-beginning 0))
+ (goto-char (point-min))
+ (while (search-forward "<dt>" nil t)
+ (replace-match "\n<blubb>"))
+ (nnweb-decode-entities)
+ (goto-char (point-min))
+ (while (re-search-forward "<blubb>.*href=\"\\([^\"]+\\)\"><strong>\\([^>]*\\)</strong></a><dd>\\([^-]+\\)- <b>\\([^<]+\\)<.*href=\"news:\\([^\"]+\\)\">.*\">\\(.+\\)</a><P>"
+ nil t)
+ (setq url (match-string 1)
+ subject (match-string 2)
+ date (match-string 3)
+ group (match-string 4)
+ id (concat "<" (match-string 5) ">")
+ from (match-string 6))
+ (incf i)
+ (unless (nnweb-get-hashtb url)
+ (push
+ (list
+ (incf (cdr active))
+ (make-full-mail-header
+ (cdr active) (concat "(" group ") " subject) from date
+ id nil 0 0 url))
+ map)
+ (nnweb-set-hashtb (cadar map) (car map))))
+ ;; See if we want more.
+ (when (or (not nnweb-articles)
+ (>= i nnweb-max-hits)
+ (not (funcall (nnweb-definition 'search)
+ nnweb-search (incf part))))
+ (setq more nil)))
+ ;; Return the articles in the right order.
+ (setq nnweb-articles
+ (sort (nconc nnweb-articles map) 'car-less-than-car)))))))
+
+(defun nnweb-altavista-wash-article ()
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (when (re-search-forward "^<strong>" nil t)
+ (delete-region (point-min) (match-beginning 0)))
+ (goto-char (point-min))
+ (while (looking-at "<strong>\\([^ ]+\\) +</strong> +\\(.*\\)$")
+ (replace-match "\\1: \\2" t)
+ (forward-line 1))
+ (when (re-search-backward "^References:" nil t)
+ (narrow-to-region (point) (progn (forward-line 1) (point)))
+ (goto-char (point-min))
+ (while (re-search-forward "<A.*\\?id@\\([^\"]+\\)\">[0-9]+</A>" nil t)
+ (replace-match "<\\1> " t)))
+ (widen)
+ (nnweb-remove-markup)))
+
+(defun nnweb-altavista-search (search &optional part)
+ (url-insert-file-contents
+ (concat
+ (nnweb-definition 'address)
+ "?"
+ (nnweb-encode-www-form-urlencoded
+ `(("pg" . "aq")
+ ("what" . "news")
+ ,@(when part `(("stq" . ,(int-to-string (* part 30)))))
+ ("fmt" . "d")
+ ("q" . ,search)
+ ("r" . "")
+ ("d0" . "")
+ ("d1" . "")))))
+ (setq buffer-file-name nil)
+ t)
+
+(provide 'nnweb)
+
+;;; nnweb.el ends here
--- /dev/null
+;;; parse-time.el --- Parsing time strings
+
+;; Copyright (C) 1996 by Free Software Foundation, Inc.
+
+;; Author: Erik Naggum <erik@arcana.naggum.no>
+;; Keywords: util
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; With the introduction of the `encode-time', `decode-time', and
+;; `format-time-string' functions, dealing with time became simpler in
+;; Emacs. However, parsing time strings is still largely a matter of
+;; heuristics and no common interface has been designed.
+
+;; `parse-time-string' parses a time in a string and returns a list of 9
+;; values, just like `decode-time', where unspecified elements in the
+;; string are returned as nil. `encode-time' may be applied on these
+;; valuse to obtain an internal time value.
+
+;;; Code:
+
+(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it
+
+(put 'parse-time-syntax 'char-table-extra-slots 0)
+
+(defvar parse-time-syntax (make-char-table 'parse-time-syntax))
+(defvar parse-time-digits (make-char-table 'parse-time-syntax))
+
+;; Byte-compiler warnings
+(defvar elt)
+(defvar val)
+
+(unless (aref parse-time-digits ?0)
+ (loop for i from ?0 to ?9
+ do (set-char-table-range parse-time-digits i (- i ?0))))
+
+(unless (aref parse-time-syntax ?0)
+ (loop for i from ?0 to ?9
+ do (set-char-table-range parse-time-syntax i ?0))
+ (loop for i from ?A to ?Z
+ do (set-char-table-range parse-time-syntax i ?A))
+ (loop for i from ?a to ?z
+ do (set-char-table-range parse-time-syntax i ?a))
+ (set-char-table-range parse-time-syntax ?+ 1)
+ (set-char-table-range parse-time-syntax ?- -1)
+ (set-char-table-range parse-time-syntax ?: ?d)
+ )
+
+(defsubst digit-char-p (char)
+ (aref parse-time-digits char))
+
+(defsubst parse-time-string-chars (char)
+ (aref parse-time-syntax char))
+
+(put 'parse-error 'error-conditions '(parse-error error))
+(put 'parse-error 'error-message "Parsing error")
+
+(defsubst parse-integer (string &optional start end)
+ "[CL] Parse and return the integer in STRING, or nil if none."
+ (let ((integer 0)
+ (digit 0)
+ (index (or start 0))
+ (end (or end (length string))))
+ (when (< index end)
+ (let ((sign (aref string index)))
+ (if (or (eq sign ?+) (eq sign ?-))
+ (setq sign (parse-time-string-chars sign)
+ index (1+ index))
+ (setq sign 1))
+ (while (and (< index end)
+ (setq digit (digit-char-p (aref string index))))
+ (setq integer (+ (* integer 10) digit)
+ index (1+ index)))
+ (if (/= index end)
+ (signal 'parse-error `("not an integer" ,(substring string (or start 0) end)))
+ (* sign integer))))))
+
+(defun parse-time-tokenize (string)
+ "Tokenize STRING into substrings."
+ (let ((start nil)
+ (end (length string))
+ (all-digits nil)
+ (list ())
+ (index 0)
+ (c nil))
+ (while (< index end)
+ (while (and (< index end) ;skip invalid characters
+ (not (setq c (parse-time-string-chars (aref string index)))))
+ (incf index))
+ (setq start index all-digits (eq c ?0))
+ (while (and (< (incf index) end) ;scan valid characters
+ (setq c (parse-time-string-chars (aref string index))))
+ (setq all-digits (and all-digits (eq c ?0))))
+ (if (<= index end)
+ (push (if all-digits (parse-integer string start index)
+ (substring string start index))
+ list)))
+ (nreverse list)))
+
+(defvar parse-time-months '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3)
+ ("Apr" . 4) ("May" . 5) ("Jun" . 6)
+ ("Jul" . 7) ("Aug" . 8) ("Sep" . 9)
+ ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)))
+(defvar parse-time-weekdays '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2)
+ ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)))
+(defvar parse-time-zoneinfo `(("Z" 0) ("UT" 0) ("GMT" 0)
+ ("PST" ,(* -8 3600)) ("PDT" ,(* -7 3600) t)
+ ("MST" ,(* -7 3600)) ("MDT" ,(* -6 3600) t)
+ ("CST" ,(* -6 3600)) ("CDT" ,(* -5 3600) t)
+ ("EST" ,(* -5 3600)) ("EDT" ,(* -4 3600) t))
+ "(zoneinfo seconds-off daylight-savings-time-p)")
+
+(defvar parse-time-rules
+ `(((6) parse-time-weekdays)
+ ((3) (1 31))
+ ((4) parse-time-months)
+ ((5) (1970 2038))
+ ((2 1 0)
+ ,#'(lambda () (and (stringp elt)
+ (= (length elt) 8)
+ (= (aref elt 2) ?:)
+ (= (aref elt 5) ?:)))
+ [0 2] [3 5] [6 8])
+ ((8 7) parse-time-zoneinfo
+ ,#'(lambda () (car val))
+ ,#'(lambda () (cadr val)))
+ ((8)
+ ,#'(lambda ()
+ (and (stringp elt)
+ (= 5 (length elt))
+ (or (= (aref elt 0) ?+) (= (aref elt 0) ?-))))
+ ,#'(lambda () (* 60 (+ (parse-integer elt 3 5)
+ (* 60 (parse-integer elt 1 3)))
+ (if (= (aref elt 0) ?-) -1 1))))
+ ((5 4 3)
+ ,#'(lambda () (and (stringp elt) (= (length elt) 10) (= (aref elt 4) ?-) (= (aref elt 7) ?-)))
+ [0 4] [5 7] [8 10])
+ ((2 1)
+ ,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:)))
+ [0 2] [3 5])
+ ((5) (70 99) ,#'(lambda () (+ 1900 elt))))
+ "(slots predicate extractor...)")
+
+(defun parse-time-string (string)
+ "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
+The values are identical to those of `decode-time', but any values that are
+unknown are returned as nil."
+ (let ((time (list nil nil nil nil nil nil nil nil nil nil))
+ (temp (parse-time-tokenize string)))
+ (while temp
+ (let ((elt (pop temp))
+ (rules parse-time-rules)
+ (exit nil))
+ (while (and (not (null rules)) (not exit))
+ (let* ((rule (pop rules))
+ (slots (pop rule))
+ (predicate (pop rule))
+ (val))
+ (if (and (not (nth (car slots) time)) ;not already set
+ (setq val (cond ((and (consp predicate)
+ (not (eq (car predicate) 'lambda)))
+ (and (numberp elt)
+ (<= (car predicate) elt)
+ (<= elt (cadr predicate))
+ elt))
+ ((symbolp predicate)
+ (cdr (assoc elt (symbol-value predicate))))
+ ((funcall predicate)))))
+ (progn
+ (setq exit t)
+ (while slots
+ (let ((new-val (and rule
+ (let ((this (pop rule)))
+ (if (vectorp this)
+ (parse-integer elt (aref this 0) (aref this 1))
+ (funcall this))))))
+ (rplaca (nthcdr (pop slots) time) (or new-val val))))))))))
+ time))
+
+(provide 'parse-time)
+
+;;; parse-time.el ends here
--- /dev/null
+;;; pop3.el --- Post Office Protocol (RFC 1460) interface
+
+;; Copyright (C) 1996,1997 Free Software Foundation, Inc.
+
+;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
+;; Keywords: mail, pop3
+;; Version: 1.3g
+
+;; 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands
+;; are implemented. The LIST command has not been implemented due to lack
+;; of actual usefulness.
+;; The optional POP3 command TOP has not been implemented.
+
+;; This program was inspired by Kyle E. Jones's vm-pop program.
+
+;;; Code:
+
+(require 'mail-utils)
+(provide 'pop3)
+
+(defconst pop3-version "1.3g")
+
+(defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil)
+ "*POP3 maildrop.")
+(defvar pop3-mailhost (or (getenv "MAILHOST") nil)
+ "*POP3 mailhost.")
+(defvar pop3-port 110
+ "*POP3 port.")
+
+(defvar pop3-password-required t
+ "*Non-nil if a password is required when connecting to POP server.")
+(defvar pop3-password nil
+ "*Password to use when connecting to POP server.")
+
+(defvar pop3-authentication-scheme 'pass
+ "*POP3 authentication scheme.
+Defaults to 'pass, for the standard USER/PASS authentication. Other valid
+values are 'apop.")
+
+(defvar pop3-timestamp nil
+ "Timestamp returned when initially connected to the POP server.
+Used for APOP authentication.")
+
+(defvar pop3-movemail-file-coding-system nil
+ "Crashbox made by pop3-movemail with this coding system.")
+
+(defvar pop3-read-point nil)
+(defvar pop3-debug nil)
+
+(defun pop3-movemail (&optional crashbox)
+ "Transfer contents of a maildrop to the specified CRASHBOX."
+ (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
+ (let* ((process (pop3-open-server pop3-mailhost pop3-port))
+ (crashbuf (get-buffer-create " *pop3-retr*"))
+ (n 1)
+ message-count)
+ ;; for debugging only
+ (if pop3-debug (switch-to-buffer (process-buffer process)))
+ (cond ((equal 'apop pop3-authentication-scheme)
+ (pop3-apop process pop3-maildrop))
+ ((equal 'pass pop3-authentication-scheme)
+ (pop3-user process pop3-maildrop)
+ (pop3-pass process))
+ (t (error "Invalid POP3 authentication scheme.")))
+ (setq message-count (car (pop3-stat process)))
+ (while (<= n message-count)
+ (message (format "Retrieving message %d of %d from %s..."
+ n message-count pop3-mailhost))
+ (pop3-retr process n crashbuf)
+ (save-excursion
+ (set-buffer crashbuf)
+ (let ((coding-system-for-write pop3-movemail-file-coding-system))
+ (append-to-file (point-min) (point-max) crashbox))
+ (set-buffer (process-buffer process))
+ (while (> (buffer-size) 5000)
+ (goto-char (point-min))
+ (forward-line 50)
+ (delete-region (point-min) (point))))
+ (pop3-dele process n)
+ (setq n (+ 1 n))
+ (if pop3-debug (sit-for 1) (sit-for 0.1))
+ )
+ (pop3-quit process)
+ (kill-buffer crashbuf)
+ )
+ )
+
+(defun pop3-open-server (mailhost port)
+ "Open TCP connection to MAILHOST.
+Returns the process associated with the connection."
+ (let ((process-buffer
+ (get-buffer-create (format "trace of POP session to %s" mailhost)))
+ (process))
+ (save-excursion
+ (set-buffer process-buffer)
+ (erase-buffer))
+ (setq process
+ (open-network-stream "POP" process-buffer mailhost port))
+ (setq pop3-read-point (point-min))
+ (let ((response (pop3-read-response process t)))
+ (setq pop3-timestamp
+ (substring response (or (string-match "<" response) 0)
+ (+ 1 (or (string-match ">" response) -1)))))
+ process
+ ))
+
+;; Support functions
+
+(defun pop3-process-filter (process output)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char (point-max))
+ (insert output)))
+
+(defun pop3-send-command (process command)
+ (set-buffer (process-buffer process))
+ (goto-char (point-max))
+;; (if (= (aref command 0) ?P)
+;; (insert "PASS <omitted>\r\n")
+;; (insert command "\r\n"))
+ (setq pop3-read-point (point))
+ (goto-char (point-max))
+ (process-send-string process command)
+ (process-send-string process "\r\n")
+ )
+
+(defun pop3-read-response (process &optional return)
+ "Read the response from the server.
+Return the response string if optional second argument is non-nil."
+ (let ((case-fold-search nil)
+ match-end)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char pop3-read-point)
+ (while (not (search-forward "\r\n" nil t))
+ (accept-process-output process 3)
+ (goto-char pop3-read-point))
+ (setq match-end (point))
+ (goto-char pop3-read-point)
+ (if (looking-at "-ERR")
+ (error (buffer-substring (point) (- match-end 2)))
+ (if (not (looking-at "+OK"))
+ (progn (setq pop3-read-point match-end) nil)
+ (setq pop3-read-point match-end)
+ (if return
+ (buffer-substring (point) match-end)
+ t)
+ )))))
+
+(defun pop3-string-to-list (string &optional regexp)
+ "Chop up a string into a list."
+ (let ((list)
+ (regexp (or regexp " "))
+ (string (if (string-match "\r" string)
+ (substring string 0 (match-beginning 0))
+ string)))
+ (store-match-data nil)
+ (while string
+ (if (string-match regexp string)
+ (setq list (cons (substring string 0 (- (match-end 0) 1)) list)
+ string (substring string (match-end 0)))
+ (setq list (cons string list)
+ string nil)))
+ (nreverse list)))
+
+(defvar pop3-read-passwd nil)
+(defun pop3-read-passwd (prompt)
+ (if (not pop3-read-passwd)
+ (if (load "passwd" t)
+ (setq pop3-read-passwd 'read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp")
+ (setq pop3-read-passwd 'ange-ftp-read-passwd)))
+ (funcall pop3-read-passwd prompt))
+
+(defun pop3-clean-region (start end)
+ (setq end (set-marker (make-marker) end))
+ (save-excursion
+ (goto-char start)
+ (while (and (< (point) end) (search-forward "\r\n" end t))
+ (replace-match "\n" t t))
+ (goto-char start)
+ (while (and (< (point) end) (re-search-forward "^\\." end t))
+ (replace-match "" t t)
+ (forward-char)))
+ (set-marker end nil))
+
+(defun pop3-munge-message-separator (start end)
+ "Check to see if a message separator exists. If not, generate one."
+ (if (not (fboundp 'message-make-date)) (autoload 'message-make-date "message"))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (if (not (or (looking-at "From .?") ; Unix mail
+ (looking-at "\001\001\001\001\n") ; MMDF
+ (looking-at "BABYL OPTIONS:") ; Babyl
+ ))
+ (let ((from (mail-strip-quoted-names (mail-fetch-field "From")))
+ (date (pop3-string-to-list (or (mail-fetch-field "Date")
+ (message-make-date))))
+ (From_))
+ ;; sample date formats I have seen
+ ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT)
+ ;; Date: 08 Jul 1996 23:22:24 -0400
+ ;; should be
+ ;; Tue Jul 9 09:04:21 1996
+ (setq date
+ (cond ((string-match "[A-Z]" (nth 0 date))
+ (format "%s %s %s %s %s"
+ (nth 0 date) (nth 2 date) (nth 1 date)
+ (nth 4 date) (nth 3 date)))
+ (t
+ ;; this really needs to be better but I don't feel
+ ;; like writing a date to day converter.
+ (format "Sun %s %s %s %s"
+ (nth 1 date) (nth 0 date)
+ (nth 3 date) (nth 2 date)))
+ ))
+ (setq From_ (format "\nFrom %s %s\n" from date))
+ (while (string-match "," From_)
+ (setq From_ (concat (substring From_ 0 (match-beginning 0))
+ (substring From_ (match-end 0)))))
+ (goto-char (point-min))
+ (insert From_))))))
+
+;; The Command Set
+
+;; AUTHORIZATION STATE
+
+(defun pop3-user (process user)
+ "Send USER information to POP3 server."
+ (pop3-send-command process (format "USER %s" user))
+ (let ((response (pop3-read-response process t)))
+ (if (not (and response (string-match "+OK" response)))
+ (error (format "USER %s not valid." user)))))
+
+(defun pop3-pass (process)
+ "Send authentication information to the server."
+ (let ((pass pop3-password))
+ (if (and pop3-password-required (not pass))
+ (setq pass
+ (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+ (if pass
+ (progn
+ (pop3-send-command process (format "PASS %s" pass))
+ (let ((response (pop3-read-response process t)))
+ (if (not (and response (string-match "+OK" response)))
+ (pop3-quit process)))))
+ ))
+
+(defvar pop3-md5-program "md5"
+ "*Program to encode its input in MD5.")
+
+(defun pop3-md5 (string)
+ (nnheader-temp-write nil
+ (insert string)
+ (call-process-region (point-min) (point-max)
+ (or shell-file-name "/bin/sh")
+ t (current-buffer) nil
+ "-c" pop3-md5-program)
+ ;; The meaningful output is the first 32 characters.
+ ;; Don't return the newline that follows them!
+ (buffer-substring (point-min) (+ (point-min) 32))))
+
+(defun pop3-apop (process user)
+ "Send alternate authentication information to the server."
+ (let ((pass pop3-password))
+ (if (and pop3-password-required (not pass))
+ (setq pass
+ (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+ (if pass
+ (let ((hash (pop3-md5 (concat pop3-timestamp pass))))
+ (pop3-send-command process (format "APOP %s %s" user hash))
+ (let ((response (pop3-read-response process t)))
+ (if (not (and response (string-match "+OK" response)))
+ (pop3-quit process)))))
+ ))
+
+;; TRANSACTION STATE
+
+(defun pop3-stat (process)
+ "Return the number of messages in the maildrop and the maildrop's size."
+ (pop3-send-command process "STAT")
+ (let ((response (pop3-read-response process t)))
+ (list (string-to-int (nth 1 (pop3-string-to-list response)))
+ (string-to-int (nth 2 (pop3-string-to-list response))))
+ ))
+
+(defun pop3-list (process &optional msg)
+ "Scan listing of available messages.
+This function currently does nothing.")
+
+(defun pop3-retr (process msg crashbuf)
+ "Retrieve message-id MSG to buffer CRASHBUF."
+ (pop3-send-command process (format "RETR %s" msg))
+ (pop3-read-response process)
+ (let ((start pop3-read-point) end)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (while (not (re-search-forward "^\\.\r\n" nil t))
+ (accept-process-output process 3)
+ ;; bill@att.com ... to save wear and tear on the heap
+ (if (> (buffer-size) 20000) (sleep-for 1))
+ (if (> (buffer-size) 50000) (sleep-for 1))
+ (if (> (buffer-size) 100000) (sleep-for 1))
+ (if (> (buffer-size) 200000) (sleep-for 1))
+ (if (> (buffer-size) 500000) (sleep-for 1))
+ ;; bill@att.com
+ (goto-char start))
+ (setq pop3-read-point (point-marker))
+;; this code does not seem to work for some POP servers...
+;; and I cannot figure out why not.
+; (goto-char (match-beginning 0))
+; (backward-char 2)
+; (if (not (looking-at "\r\n"))
+; (insert "\r\n"))
+; (re-search-forward "\\.\r\n")
+ (goto-char (match-beginning 0))
+ (setq end (point-marker))
+ (pop3-clean-region start end)
+ (pop3-munge-message-separator start end)
+ (save-excursion
+ (set-buffer crashbuf)
+ (erase-buffer))
+ (copy-to-buffer crashbuf start end)
+ (delete-region start end)
+ )))
+
+(defun pop3-dele (process msg)
+ "Mark message-id MSG as deleted."
+ (pop3-send-command process (format "DELE %s" msg))
+ (pop3-read-response process))
+
+(defun pop3-noop (process msg)
+ "No-operation."
+ (pop3-send-command process "NOOP")
+ (pop3-read-response process))
+
+(defun pop3-last (process)
+ "Return highest accessed message-id number for the session."
+ (pop3-send-command process "LAST")
+ (let ((response (pop3-read-response process t)))
+ (string-to-int (nth 1 (pop3-string-to-list response)))
+ ))
+
+(defun pop3-rset (process)
+ "Remove all delete marks from current maildrop."
+ (pop3-send-command process "RSET")
+ (pop3-read-response process))
+
+;; UPDATE
+
+(defun pop3-quit (process)
+ "Close connection to POP3 server.
+Tell server to remove all messages marked as deleted, unlock the maildrop,
+and close the connection."
+ (pop3-send-command process "QUIT")
+ (pop3-read-response process t)
+ (if process
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char (point-max))
+ (delete-process process))))
+\f
+;; Summary of POP3 (Post Office Protocol version 3) commands and responses
+
+;;; AUTHORIZATION STATE
+
+;; Initial TCP connection
+;; Arguments: none
+;; Restrictions: none
+;; Possible responses:
+;; +OK [POP3 server ready]
+
+;; USER name
+;; Arguments: a server specific user-id (required)
+;; Restrictions: authorization state [after unsuccessful USER or PASS
+;; Possible responses:
+;; +OK [valid user-id]
+;; -ERR [invalid user-id]
+
+;; PASS string
+;; Arguments: a server/user-id specific password (required)
+;; Restrictions: authorization state, after successful USER
+;; Possible responses:
+;; +OK [maildrop locked and ready]
+;; -ERR [invalid password]
+;; -ERR [unable to lock maildrop]
+
+;;; TRANSACTION STATE
+
+;; STAT
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;; +OK nn mm [# of messages, size of maildrop]
+
+;; LIST [msg]
+;; Arguments: a message-id (optional)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;; +OK [scan listing follows]
+;; -ERR [no such message]
+
+;; RETR msg
+;; Arguments: a message-id (required)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;; +OK [message contents follow]
+;; -ERR [no such message]
+
+;; DELE msg
+;; Arguments: a message-id (required)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;; +OK [message deleted]
+;; -ERR [no such message]
+
+;; NOOP
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;; +OK
+
+;; LAST
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;; +OK nn [highest numbered message accessed]
+
+;; RSET
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;; +OK [all delete marks removed]
+
+;;; UPDATE STATE
+
+;; QUIT
+;; Arguments: none
+;; Restrictions: none
+;; Possible responses:
+;; +OK [TCP connection closed]
--- /dev/null
+;;; score-mode.el --- mode for editing Gnus score files
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news, 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'easymenu)
+(require 'timezone)
+(eval-when-compile (require 'cl))
+
+(defvar gnus-score-mode-hook nil
+ "*Hook run in score mode buffers.")
+
+(defvar gnus-score-menu-hook nil
+ "*Hook run after creating the score mode menu.")
+
+(defvar gnus-score-edit-exit-function nil
+ "Function run on exit from the score buffer.")
+
+(defvar gnus-score-mode-map nil)
+(unless gnus-score-mode-map
+ (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map))
+ (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit)
+ (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date)
+ (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print))
+
+;;;###autoload
+(defun gnus-score-mode ()
+ "Mode for editing Gnus score files.
+This mode is an extended emacs-lisp mode.
+
+\\{gnus-score-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map gnus-score-mode-map)
+ (gnus-score-make-menu-bar)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
+ (setq major-mode 'gnus-score-mode)
+ (setq mode-name "Score")
+ (lisp-mode-variables nil)
+ (make-local-variable 'gnus-score-edit-exit-function)
+ (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook))
+
+(defun gnus-score-make-menu-bar ()
+ (unless (boundp 'gnus-score-menu)
+ (easy-menu-define
+ gnus-score-menu gnus-score-mode-map ""
+ '("Score"
+ ["Exit" gnus-score-edit-exit t]
+ ["Insert date" gnus-score-edit-insert-date t]
+ ["Format" gnus-score-pretty-print t]))
+ (run-hooks 'gnus-score-menu-hook)))
+
+(defun gnus-score-edit-insert-date ()
+ "Insert date in numerical format."
+ (interactive)
+ (princ (gnus-score-day-number (current-time)) (current-buffer)))
+
+(defun gnus-score-pretty-print ()
+ "Format the current score file."
+ (interactive)
+ (goto-char (point-min))
+ (let ((form (read (current-buffer))))
+ (erase-buffer)
+ (pp form (current-buffer)))
+ (goto-char (point-min)))
+
+(defun gnus-score-edit-exit ()
+ "Stop editing the score file."
+ (interactive)
+ (unless (file-exists-p (file-name-directory (buffer-file-name)))
+ (make-directory (file-name-directory (buffer-file-name)) t))
+ (save-buffer)
+ (bury-buffer (current-buffer))
+ (let ((buf (current-buffer)))
+ (when gnus-score-edit-exit-function
+ (funcall gnus-score-edit-exit-function))
+ (when (eq buf (current-buffer))
+ (switch-to-buffer (other-buffer (current-buffer))))))
+
+(defun gnus-score-day-number (time)
+ (let ((dat (decode-time time)))
+ (timezone-absolute-from-gregorian
+ (nth 4 dat) (nth 3 dat) (nth 5 dat))))
+
+(provide 'score-mode)
+
+;;; score-mode.el ends here
--- /dev/null
+;;; smiley.el --- displaying smiley faces
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+
+;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu>
+;; Keywords: fun
+
+;; 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 2, 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+;; comments go here.
+;;
+
+;;; Test smileys: :-] :-o :-) ;-) :-\ :-| :-d :-P 8-| :-(
+
+;; To use:
+;; (require 'smiley)
+;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t)
+
+;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
+
+(require 'annotations)
+(require 'messagexmas)
+(require 'cl)
+(require 'custom)
+
+(defgroup smiley nil
+ "Turn :-)'s into real images (XEmacs)."
+ :group 'gnus-visual)
+
+(defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies")
+ "Location of the smiley faces files."
+ :type 'directory
+ :group 'smiley)
+
+;; Notice the subtle differences in the regular expressions in the
+;; two alists below.
+
+(defcustom smiley-deformed-regexp-alist
+ '(("\\(\\^_?\\^;;;\\)\\W" 1 "WideFaceAse3.xbm")
+ ("\\(\\^_?\\^;;\\)\\W" 1 "WideFaceAse2.xbm")
+ ("\\(\\^_?\\^;\\)\\W" 1 "WideFaceAse1.xbm")
+ ("\\(\\^_?\\^\\)\\W" 1 "WideFaceSmile.xbm")
+ ("\\(;_;\\)\\W" 1 "WideFaceWeep.xbm")
+ ("\\(T_T\\)\\W" 1 "WideFaceWeep.xbm")
+ ("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm")
+ ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
+ ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
+ ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
+ ("\\(=[)>»]+\\)\\W" 1 "FaceHappy.xpm")
+ ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm")
+ ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
+ ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm")
+ ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm")
+ ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm")
+ ("\\(:-*[Oo\*]\\)\\W" 1 "FaceStartled.xpm")
+ ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm")
+ ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm")
+ ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm")
+ ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
+ ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
+ ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm"))
+ "Normal and deformed faces for smilies."
+ :type '(repeat (list regexp
+ (integer :tag "Match")
+ (string :tag "Image")))
+ :group 'smiley)
+
+(defcustom smiley-nosey-regexp-alist
+ '(("\\(:-+[<«]+\\)\\W" 1 "FaceAngry.xpm")
+ ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
+ ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm")
+ ("\\(:-+[}»]+\\)\\W" 1 "FaceHappy.xpm")
+ ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm")
+ ("\\(=[)>]+\\)\\W" 1 "FaceHappy.xpm")
+ ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm")
+ ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
+ ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm")
+ ("\\(:-+[({]+\\)\\W" 1 "FaceSad.xpm")
+ ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm")
+ ("\\(:-+[Oo\*]\\)\\W" 1 "FaceStartled.xpm")
+ ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm")
+ ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm")
+ ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm")
+ ("\\(;-+[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
+ ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm")
+ ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm")
+ ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm"))
+ "Smileys with noses. These get less false matches."
+ :type '(repeat (list regexp
+ (integer :tag "Match")
+ (string :tag "Image")))
+ :group 'smiley)
+
+(defcustom smiley-regexp-alist smiley-deformed-regexp-alist
+ "A list of regexps to map smilies to real images.
+Defaults to the contents of `smiley-deformed-regexp-alist'.
+An alternative is `smiley-nosey-regexp-alist' that matches less
+aggressively.
+If this is a symbol, take its value."
+ :type '(radio (variable-item smiley-deformed-regexp-alist)
+ (variable-item smiley-nosey-regexp-alist)
+ symbol
+ (repeat (list regexp
+ (integer :tag "Match")
+ (string :tag "Image"))))
+ :group 'smiley)
+
+(defcustom smiley-flesh-color "yellow"
+ "Flesh color."
+ :type 'string
+ :group 'smiley)
+
+(defcustom smiley-features-color "black"
+ "Features color."
+ :type 'string
+ :group 'smiley)
+
+(defcustom smiley-tongue-color "red"
+ "Tongue color."
+ :type 'string
+ :group 'smiley)
+
+(defcustom smiley-circle-color "black"
+ "Circle color."
+ :type 'string
+ :group 'smiley)
+
+(defcustom smiley-mouse-face 'highlight
+ "Face used for mouse highlighting in the smiley buffer.
+
+Smiley buttons will be displayed in this face when the cursor is
+above them."
+ :type 'face
+ :group 'smiley)
+
+
+(defvar smiley-glyph-cache nil)
+(defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
+
+(defvar smiley-map (make-sparse-keymap "smiley-keys")
+ "Keymap to toggle smiley states.")
+
+(define-key smiley-map [(button2)] 'smiley-toggle-extent)
+
+(defun smiley-create-glyph (smiley pixmap)
+ (and
+ smiley-running-xemacs
+ (or
+ (cdr-safe (assoc pixmap smiley-glyph-cache))
+ (let* ((xpm-color-symbols
+ (and (featurep 'xpm)
+ (append `(("flesh" ,smiley-flesh-color)
+ ("features" ,smiley-features-color)
+ ("tongue" ,smiley-tongue-color))
+ xpm-color-symbols)))
+ (glyph (make-glyph
+ (list
+ (cons 'x (expand-file-name pixmap smiley-data-directory))
+ (cons 'tty smiley)))))
+ (setq smiley-glyph-cache (cons (cons pixmap glyph) smiley-glyph-cache))
+ (set-glyph-face glyph 'default)
+ glyph))))
+
+;;;###autoload
+(defun smiley-region (beg end)
+ "Smilify the region between point and mark."
+ (interactive "r")
+ (smiley-buffer (current-buffer) beg end))
+
+(defun smiley-toggle-extent (event)
+ "Toggle smiley at given point"
+ (interactive "e")
+ (let* ((ant (event-glyph-extent event))
+ (pt (event-closest-point event))
+ ext)
+ (if (annotationp ant)
+ (when (extentp (setq ext (extent-property ant 'smiley-extent)))
+ (set-extent-property ext 'invisible nil)
+ (hide-annotation ant))
+ (when pt
+ (while (setq ext (extent-at pt (event-buffer event) nil ext 'at))
+ (when (annotationp (setq ant
+ (extent-property ext 'smiley-annotation)))
+ (reveal-annotation ant)
+ (set-extent-property ext 'invisible t)))))))
+
+;;;###autoload
+(defun smiley-buffer (&optional buffer st nd)
+ (interactive)
+ (when (featurep 'x)
+ (save-excursion
+ (when buffer
+ (set-buffer buffer))
+ (let ((buffer-read-only nil)
+ (alist (if (symbolp smiley-regexp-alist)
+ (symbol-value smiley-regexp-alist)
+ smiley-regexp-alist))
+ (case-fold-search nil)
+ entry regexp beg group file)
+ (goto-char (or st (point-min)))
+ (setq beg (point))
+ ;; loop through alist
+ (while (setq entry (pop alist))
+ (setq regexp (car entry)
+ group (cadr entry)
+ file (caddr entry))
+ (goto-char beg)
+ (while (re-search-forward regexp nd t)
+ (let* ((start (match-beginning group))
+ (end (match-end group))
+ (glyph (smiley-create-glyph (buffer-substring start end)
+ file)))
+ (when glyph
+ (mapcar 'delete-annotation (annotations-at end))
+ (let ((ext (make-extent start end))
+ (ant (make-annotation glyph end 'text)))
+ ;; set text extent params
+ (set-extent-property ext 'end-open t)
+ (set-extent-property ext 'start-open t)
+ (set-extent-property ext 'invisible t)
+ (set-extent-property ext 'keymap smiley-map)
+ (set-extent-property ext 'mouse-face smiley-mouse-face)
+ (set-extent-property ext 'intangible t)
+ ;; set annotation params
+ (set-extent-property ant 'mouse-face smiley-mouse-face)
+ (set-extent-property ant 'keymap smiley-map)
+ ;; remember each other
+ (set-extent-property ant 'smiley-extent ext)
+ (set-extent-property ext 'smiley-annotation ant))
+ (when (smiley-end-paren-p start end)
+ (make-annotation ")" end 'text))
+ (goto-char end)))))))))
+
+(defun smiley-end-paren-p (start end)
+ "Try to guess whether the current smiley is an end-paren smiley."
+ (save-excursion
+ (goto-char start)
+ (when (and (re-search-backward "[()]" nil t)
+ (= (following-char) ?\()
+ (goto-char end)
+ (or (not (re-search-forward "[()]" nil t))
+ (= (char-after (1- (point))) ?\()))
+ t)))
+
+(defvar gnus-article-buffer)
+;;;###autoload
+(defun gnus-smiley-display ()
+ "Display \"smileys\" as small graphical icons."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char (point-min))
+ ;; We skip the headers.
+ (unless (search-forward "\n\n" nil t)
+ (goto-char (point-max)))
+ (smiley-buffer (current-buffer) (point))))
+
+(provide 'smiley)
+
+;;; smiley.el ends here
--- /dev/null
+This package contains a beta version of Gnus. The lisp directory
+contains the source lisp files, and the texi directory contains a
+draft of the Gnus info pages.
+
+To use Gnus you first have to unpack the files, which you've obviously
+done, because you are reading this.
+
+You should definitely byte-compile the source files. To do that, you
+can simply say "make" in this directory. If you are using XEmacs, you
+*must* say "make EMACS=xemacs". In that case you may also want to
+pull down the package of nice glyphs from
+<URL:http://www.gnus.org/~larsi/etc.tar.gz>. It should be installed
+into the "gnus-5.4.53/etc" directory.
+
+Then you have to tell Emacs where Gnus is. You might put something
+like
+
+ (setq load-path (cons (expand-file-name "~/gnus-5.4.53/lisp") load-path))
+
+in your .emacs file, or wherever you keep such things.
+
+To enable reading the Gnus manual, you could say something like:
+
+ (setq Info-default-directory-list
+ (cons "~/gnus-5.4.53/texi" Info-default-directory-list))
+
+Note that Gnus and GNUS can't coexist in a single Emacs. They both use
+the same function and variable names. If you have been running GNUS
+in your Emacs, you should probably exit that Emacs and start a new one
+to fire up Gnus.
+
+Gnus does absolutely not work with anything older than Emacs 19.33 or
+XEmacs 19.14. So you definitely need a new Emacs.
+
+Then you do a `M-x gnus', and everything should... uhm... it should
+work, but it might not. Set `debug-on-error' to t, and mail me the
+backtraces, or, better yet, find out why Gnus does something wrong,
+fix it, and send me the diffs. :-)
+
+There are four main things I want your help and input on:
+
+1) Startup. Does everything go smoothly, and why not?
+
+2) Any errors while you read news normally?
+
+3) Any errors if you do anything abnormal?
+
+4) Features you do not like, or do like, but would like to tweak a
+ bit, and features you would like to see.
+
+Send any comments and all your bug fixes/complaints to
+`bugs@gnus.org'.
--- /dev/null
+Sat Sep 27 04:24:41 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.texi (Various Commands): Addition.
+
+Wed Sep 24 02:38:21 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Example Setup): Wrong info.
+ (SOUP Groups): Addition.
+ (Contributors): Addition.
+
+1997-09-22 SL Baur <steve@altair.xemacs.org>
+
+ * gnus.texi (Finding the Parent): Fix typo.
+ (NoCeM): Fix typos.
+
+Tue Sep 23 07:05:48 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (NoCeM): Addition.
+ (Finding the Parent): Addition.
+
+Mon Sep 22 06:13:00 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Filling In Threads): Addition.
+ (Finding the Parent): Addition.
+
+Sun Sep 21 04:35:56 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (NNTP): Addition.
+ (Hiding Headers): Addition.
+ (Symbolic Prefixes): New.
+ (Extended Interactive): New.
+ (Summary Score Commands): Addition.
+
+Sat Sep 20 20:53:43 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Startup Variables): Addition.
+
+1997-09-16 SL Baur <steve@altair.xemacs.org>
+
+ * gnus.texi: Correct typo.
+
+Wed Sep 17 02:32:56 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Customizing Threading): Broken up into five nodes.
+ (Article Washing): Addition.
+
+ * message.texi (Various Commands): Add.
+
+Tue Sep 16 04:04:03 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Example Setup): New.
+
+Mon Sep 15 23:10:05 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Customizing Threading): Addition.
+
+Sun Sep 14 21:59:07 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Outgoing Messages): New.
+ (Score File Format): Note.
+ (Subscription Methods): Fix.
+ (Starting Up): Fix.
+ (Threading): Add.
+
+Sat Jul 19 23:02:03 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Followups To Yourself): \\(_-_\\)?
+
+Sat Jul 12 16:29:35 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Picon Configuration): Moved Picons to under XEmacs.
+ (Smileys): New section.
+
+Fri Jul 11 11:58:20 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (NNTP): Addition.
+
+Tue Jun 17 23:52:17 1997 Justin Sheehy <dworkin@ccs.neu.edu>
+
+ * gnus.texi (Group Parameters): Addition.
+
+Sun May 25 14:40:17 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Expiring Mail): Addition.
+
+Sat May 24 05:26:17 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Score File Format): Update.
+
+Tue May 20 21:56:03 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Document Server Internals): Typo.
+
+Sun May 18 05:59:24 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Topic Commands): Addition.
+
+Sun May 11 20:09:24 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Article Hiding): Change.
+
+Thu May 8 23:48:36 1997 James Troup <J.J.Troup@comp.brad.ac.uk>
+
+ * gnus.texi (Saving Articles): Typo.
+
+Wed May 7 19:00:48 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Saving Articles): Addition.
+
+Wed May 7 19:00:43 1997 Mark Boyns <boyns@sdsu.edu>
+
+ * gnus.texi (Saving Articles): Addition.
+
+Thu May 1 14:06:57 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Score File Format): Fix.
+
+Sun Apr 27 11:11:43 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (NNTP): Addition.
+
+Sat Apr 12 16:51:32 1997 Robert Bihlmeyer <robbe@orcus.priv.at>
+
+ * gnus.texi (Thwarting Email Spam): Addition.
+
+Tue Apr 15 16:11:38 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.texi (Various Message Variables): Addition.
+
+ * gnus.texi (Thwarting Email Spam): Addition.
+
+Sat Apr 12 00:26:47 1997 Francois Felix Ingrand <felix@laas.fr>
+
+ * gnus.texi (NoCeM): Addition.
+
+Thu Apr 10 21:25:14 1997 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnus.texi (Emacs/XEmacs Code): Addition.
+
+Thu Apr 10 20:45:47 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Group Information): Fix.
+
+Wed Apr 2 11:48:44 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Sorting): Use total score.
+
+Tue Apr 1 11:44:57 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Subscription Methods): Addition.
+ (Group Info): Addition.
+ (Gnus Utility Functions): New.
+ (Thwarting Email Spam): Addition.
+
+Mon Mar 31 16:15:54 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.texi (Various Message Variables): Addition.
+
+Sun Mar 23 02:16:19 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Thwarting Email Spam): New.
+ (Unavailable Servers): Fix.
+
+Wed Mar 19 15:45:17 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Various Summary Stuff): Addition.
+ (Mail Backend Variables): Addition.
+
+Tue Mar 18 14:43:32 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Article Washing): Not addition.
+
+Mon Mar 17 16:15:54 1997 Philippe Schnoebelen <Philippe.Schnoebelen@lsv.ens-cachan.fr>
+
+ * Makefile (install): Install properly.
+
+Fri Mar 14 21:00:33 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Group Parameters): Addition.
+ (Expiring Mail): Addition.
+
+Wed Mar 12 06:57:14 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Various Various): Addition.
+
+Sat Mar 8 03:41:47 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Group Parameters): Added example.
+ (Duplicates): Fix.
+
+Fri Mar 7 10:49:43 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * Makefile: New "install" target.
+
+Thu Mar 6 08:01:37 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Mail and Procmail): Fix.
+
+Sun Mar 2 02:08:40 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Startup Files): Addition.
+ (Score File Format): Fix.
+
+Fri Feb 28 23:23:31 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Archived Messages): Clarify.
+ (Fuzzy Matching): New.
+
+Mon Feb 24 23:41:57 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.texi (Compatibility): New.
+
+Thu Feb 20 03:29:17 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Foreign Groups): Addition.
+
+Wed Feb 19 02:57:51 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Server Variables): New.
+
+Sun Feb 16 15:43:34 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Mail Backend Variables): Fix.
+
+ * message.texi (Various Message Variables): Addition.
+
+Mon Feb 10 07:18:16 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Article Commands): Addition.
+
+Mon Feb 3 19:59:10 1997 Paul Franklin <paul@cs.washington.edu>
+
+ * gnus-group.el (gnus-group-edit-group): Allow editing of bad
+ groups.
+
+Wed Feb 5 02:00:46 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.texi (Mail Variables): Change.
+
+Tue Feb 4 02:33:31 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.texi (Mail Aliases): New.
+
+ * gnus.texi (Splitting Mail): Addition.
+
+Mon Feb 3 07:31:47 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Mode Lines): Addition.
+
+Mon Jan 27 17:51:29 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Highlighting and Menus): Removed
+ `gnus-display-type'.
+
+Sat Jan 25 08:09:30 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (The Active File): Addition.
+
+Fri Jan 24 05:07:28 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Summary Mail Commands): Addition.
+ (Required Backend Functions): Deletia.
+ (Article Washing): Addition.
+ (Summary Mail Commands): Addition.
+
+Mon Jan 20 22:19:40 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Followups To Yourself): Fix.
+
+Fri Jan 17 00:55:51 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (NoCeM): Update.
+
+Wed Jan 15 02:23:03 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Mail Group Commands): Fix.
+
+Tue Jan 7 09:36:36 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Summary Buffer Lines): Correction.
+
+Mon Jan 6 22:49:12 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (NoCeM): Addition.
+
+Fri Jan 3 18:13:02 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.texi (Various Commands): Addition.
+
+Thu Jan 2 16:12:27 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Optional Backend Functions): Fix.
+
+Mon Dec 16 13:53:28 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Exiting the Summary Buffer): Update.
+
+Fri Dec 13 01:04:41 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Limiting): Addition.
+
+Sat Dec 7 21:10:23 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Example Methods): Addition.
+
+Fri Dec 6 12:38:14 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Group Parameters): Update.
+
+1996-11-30 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Terminology): Addition.
+
+Wed Nov 27 03:13:05 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Selecting a Group): Addition.
+
+Tue Nov 26 12:42:47 1996 Martin Buchholz <mrb@eng.sun.com>
+
+ * message.texi: Typo fixes and stuff.
+
+Thu Nov 21 17:45:57 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Canceling and Superseding): Fix.
+
+Wed Nov 20 15:42:36 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (New Groups): Addition.
+ (Summary Sorting): Addition.
+
+Tue Nov 19 20:54:16 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Scanning New Messages): Addition.
+
+Sat Nov 9 06:04:22 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Group Parameters): Addition.
+
+Fri Nov 8 04:01:06 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Article Fontisizing): New.
+ (Fancy Mail Splitting): Addition.
+ (Summary Post Commands): Addition.
+ (Mail Spool): Addition.
+ (Server Commands): Addition.
+ (Fancy Mail Splitting): Addition.
+
+Wed Nov 6 06:39:44 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Misc Article): Addition.
+ (Emacsen): Updated.
+
+Wed Nov 6 03:52:05 1996 C. R. Oldham <cro@nca.asu.edu>
+
+ * Makefile (.texi.dvi): Fix rule.
+
+Tue Nov 5 10:45:39 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Other Decode Variables): Addition.
+ (Mail-like Backends): New.
+
+Tue Nov 5 06:41:46 1996 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnus.texi (Score File Format): Added warning.
+
+Mon Oct 28 15:50:08 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Startup Variables): Addition.
+
+Fri Oct 25 09:04:59 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Summary Mail Commands): Addition.
+
+Wed Oct 23 08:28:29 1996 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnus.texi (Fancy Mail Splitting): Removed trailing garbage.
+
+Tue Oct 22 07:36:02 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Converting Kill Files): New.
+
+Sat Oct 19 07:17:28 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Saving Articles): Addition.
+
+ * message.texi (Various Message Variables): Addition.
+
+Thu Oct 17 06:53:04 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Contributors): Added names.
+
+Fri Oct 11 12:38:59 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.texi (Adaptive Scoring): Addition.
+
+Tue Oct 8 13:16:41 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * Makefile (all): Make custom.
+
+Wed Oct 2 01:32:49 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Group Timestamps): New.
+
+Tue Oct 1 01:34:45 1996 Lars Magne Ingebrigtsen <larsi@hrym.ifi.uio.no>
+
+ * gnus.texi (Expiring Mail): Addition.
+ (Group Line Specification): Addition.
+
+Sat Sep 28 21:36:40 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.texi (Foreign Groups): Addition.
+
+Mon Sep 23 22:17:44 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (The Summary Buffer): Addition.
+
+Mon Sep 23 18:25:38 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.texi (Thread Commands): Correction.
+ (Group Information): Correction.
+
+Sat Sep 21 08:11:43 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (New Groups): Split into three nodes.
+ (Group Parameters): Shortened.
+ (Browse Foreign Server): Corrected.
+
+Thu Sep 19 18:45:15 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Mail and Procmail): Addition.
+
+Wed Sep 18 07:33:11 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Other Marks): Edited.
+ (The Manual): New.
+ (Contributors): Updated.
+ (Asynchronous Fetching): Addition.
+ (New Features): Split.
+ ((ding) Gnus): Renamed.
+ (September Gnus): New.
+ (Red Gnus): New,
+ (Undo): New.
+
+Thu Sep 12 23:55:53 1996 Lars Magne Ingebrigtsen <larsi@hrym.ifi.uio.no>
+
+ * gnus.texi (Archived Messages): Fix.
+
+Sat Sep 7 12:14:23 1996 Lars Magne Ingebrigtsen <larsi@hymir.ifi.uio.no>
+
+ * gnus.texi (Various Various): Addition.
+
+Fri Sep 6 07:57:26 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Startup Files): Addition.
+ (Splitting Mail): Addition.
+ (Sorting Groups): Addition.
+ (Topic Sorting): New.
+ (Really Various Summary Commands): Deletia.
+ (Summary Generation Commands): New.
+ (Setting Process Marks): Addition.
+
+Thu Sep 5 07:34:27 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Terminology): Addition.
+ (Web Searches): Fix.
+ (Windows Configuration): Addition.
+
+Sun Sep 1 11:07:09 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (XEmacs Enhancements): New.
+
+Sat Aug 31 02:55:50 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.texi (Washing Mail): Addition.
+
+Fri Aug 30 09:10:17 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Washing Mail): New.
+ (Fancy Mail Splitting): Change.
+
+Fri Aug 30 00:21:59 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Foreign Groups): Change.
+
+Thu Aug 29 23:51:45 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Daemons): Addition.
+
+Thu Aug 29 02:09:24 1996 François Pinard <pinard@progiciels-bpi.ca>
+
+ * gnus.texi (Web Searches): Typo.
+
+Wed Aug 28 08:21:36 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Server Commands): Addition.
+ (Really Various Summary Commands): Addition.
+
+Mon Aug 26 18:29:23 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Optional Backend Functions): Deletia.
+ (Asynchronous Fetching): Deletia and addition.
+
+Sun Aug 25 23:39:03 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi: Include the version number.
+
+Sun Aug 25 21:31:33 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.texi (Really Various Summary Commands): Addition.
+
+Sat Aug 17 22:24:34 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Startup Files): Addition.
+ (Anything Groups): Addition.
+
+Thu Aug 22 17:27:31 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Adaptive Scoring): Addition.
+ (Adaptive Scoring): Addition.
+
+Mon Aug 19 00:30:07 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Fancy Mail Splitting): Addition.
+ (Splitting Mail): Addition.
+ (Group Parameters): Addition.
+ (Topic Variables): Addition.
+ (Mail Group Commands): Addition.
+ (Group Information): Addition.
+ (Article Washing): Addition.
+
+Sun Aug 18 18:06:49 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Web Searches): Change and addition.
+
+Sat Aug 17 22:24:34 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Startup Files): Addition.
+ (Anything Groups): Addition.
+
+Thu Aug 15 17:59:12 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Followups To Yourself): Addition.
+ (Setting Process Marks): Addition.
+ (Process/Prefix): Addition.
+ (Startup Files): Addition.
+ (Mail-To-News Gateways): New.
+
+Wed Aug 14 15:02:14 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Home Score File): Fix.
+ (Various Various): New.
+
+Tue Aug 13 10:38:47 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Error Messaging): New.
+ (Mail Backend Variables): Fix.
+ (Foreign Groups): Added references.
+ (Sorting Groups): Addition.
+
+Sun Aug 11 02:52:37 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (User-Defined Specs): Correction.
+ (Unavailable Servers): Addition.
+ (Moderation): New.
+ (Summary Mail Commands): Addition.
+ (Crosspost Handling): Addition.
+
+Sat Aug 10 00:13:39 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Summary Buffer Lines): Correction.
+ (Top): Name fix.
+ (Compilation ): Addition.
+ (Group Parameters): Addition.
+ (Troubleshooting): Addition.
+
+Fri Aug 9 07:17:59 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Selecting a Group): Addition.
+ (Score Decays): New.
+ (Score File Format): Addition.
+ (Changing Servers): Addition.
+ (Selecting a Group): Addition.
+ (Really Various Summary Commands): Addition.
+
+Thu Aug 8 05:39:31 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Read Articles): Addition.
+ (Foreign Groups): Addition.
+ (User-Defined Specs): Separated.
+ (Formatting Fonts): Ditto.
+ (Advanced Formatting): New.
+ (Formatting Basics): Addition.
+ (Formatting Variables): Split.
+
+Wed Aug 7 22:00:56 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Hooking New Backends Into Gnus): New node.
+
+Wed Aug 7 01:02:08 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Setting Marks): Addition.
+ (Formatting Variables): Addition.
+
+Mon Aug 5 20:20:42 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Formatting Variables): Addition.
+
+Sun Aug 4 07:15:28 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Score File Format): Addition.
+ (Adaptive Scoring): Addition.
+
+Sat Aug 3 17:35:36 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Group Parameters): Addition.
+ (Home Score File): New.
+ (Topic Parameters): New.
+
+Wed Jul 31 15:34:12 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (are): Fix.
+
+Wed Jul 31 15:32:57 1996 David S. Goldberg <dsg@linus.mitre.org>
+
+ * gnus.texi (buffer-name): Addition.
+
+Fri Aug 2 00:32:39 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Pick and Read): Addition.
+ (Article Hiding): Addition.
+ (Article Signature): Made into own node.
+
+Thu Aug 1 00:25:41 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * message.texi (Wide Reply): Addition.
+ (Bouncing): Addition.
+
+ * gnus.texi (Crosspost Handling): Made into own node.
+ (Duplicate Suppression): New.
+ (Document Server Internals): New.
+ (Changing Servers): New.
+
+Wed Jul 31 15:37:44 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi: Fix
+
+Mon Jul 29 10:12:24 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Misc Article): Addition.
+ (Advanced Scoring Tips): New.
+ (Advanced Scoring Example): New.
+ (Advanced Scoring Syntax): New.
+ (Advanced Scoring): New.
+
--- /dev/null
+TEXI2DVI=texi2dvi
+EMACS=emacs
+MAKEINFO=$(EMACS) -batch -q -no-site-file
+INFOSWI=-l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer
+XINFOSWI=-l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer
+LATEX=latex
+DVIPS=dvips
+PERL=perl
+INFODIR=/usr/local/info
+
+all: gnus message
+
+most: texi2latex.elc latex latexps
+
+gnus: gnus.texi
+ $(MAKEINFO) -eval '(find-file "gnus.texi")' $(XINFOSWI)
+
+message: message.texi
+ $(MAKEINFO) -eval '(find-file "message.texi")' $(XINFOSWI)
+
+dvi: gnus.dvi message.dvi
+
+.texi.dvi :
+ $(PERL) -n -e 'print unless (/\@iflatex/ .. /\@end iflatex/)' $< > gnustmp.texi
+ $(TEXI2DVI) gnustmp.texi
+ cp gnustmp.dvi $*.dvi
+ rm gnustmp.*
+
+refcard.dvi: refcard.tex gnuslogo.refcard gnusref.tex
+ $(LATEX) refcard.tex
+
+sclean:
+ rm -f gnus.*.bak *.ky *.cp *.fn *.cps *.kys *.log *.aux *.dvi *.vr \
+ *.tp *.toc \
+ *.pg gnus.latexi *.aux *.[cgk]idx \
+ gnus.ilg gnus.ind gnus.[cgk]ind gnus.idx \
+ gnus.tmptexi gnus.tmplatexi gnus.tmplatexi1 texput.log *.orig *.rej \
+ gnus.latexi*~*
+
+clean:
+ make sclean
+ rm -f *.latexi
+ rm tmp/*.ps
+
+makeinfo:
+ makeinfo -o gnus gnus.texi
+ makeinfo -o message message.texi
+
+texi2latex.elc: texi2latex.el
+ $(EMACS) -batch -l bytecomp -f batch-byte-recompile-directory
+
+latex: gnus.texi
+ $(EMACS) -batch -q -no-site-file gnus.texi -l ./texi2latex.elc -f latexi-translate
+
+latexps:
+ make texi2latex.elc
+ egrep -v "label.*Index|chapter.*Index" gnus.latexi > gnus.tmplatexi1
+ $(LATEX) gnus.tmplatexi1
+ splitindex
+ makeindex -o gnus.kind gnus.kidx
+ makeindex -o gnus.cind gnus.cidx
+ makeindex -o gnus.gind gnus.gidx
+ sed 's/\\char 5E\\relax {}/\\symbol{"5E}/' < gnus.kind > gnus.tmpkind
+ mv gnus.tmpkind gnus.kind
+ egrep -v "end{document}" gnus.tmplatexi1 > gnus.tmplatexi
+ cat postamble.tex >> gnus.tmplatexi
+ $(LATEX) gnus.tmplatexi
+ $(LATEX) gnus.tmplatexi
+ $(DVIPS) -f gnus.dvi > /local/tmp/larsi/gnus.ps
+
+pss:
+ make latex
+ make latexps
+
+psout:
+ make latex
+ make latexboth
+ make out
+
+latexboth:
+ rm -f gnus-manual-a4.ps.gz gnus-manual-standard.ps.gz
+ make latexps
+ mv /local/tmp/larsi/gnus.ps /local/tmp/larsi/gnus-manual-a4.ps
+ gzip /local/tmp/larsi/gnus-manual-a4.ps
+ sed 's/,a4paper//' gnus.latexi > gnus-standard.latexi
+ mv gnus-standard.latexi gnus.latexi
+ make latexps
+ mv /local/tmp/larsi/gnus.ps /local/tmp/larsi/gnus-manual-standard.ps
+ gzip /local/tmp/larsi/gnus-manual-standard.ps
+
+out:
+ cp /local/tmp/larsi/gnus-manual-standard.ps.gz \
+ /local/tmp/larsi/gnus-manual-a4.ps.gz \
+ /local/ftp/pub/emacs/gnus/manual
+ mv /local/tmp/larsi/gnus-manual-standard.ps.gz \
+ /local/tmp/larsi/gnus-manual-a4.ps.gz \
+ /hom/larsi/www_docs/www.gnus.org/documents
+
+veryclean:
+ make clean
+ rm -f gnus.dvi gnus.ps
+
+distclean:
+ make clean
+ rm -f *.orig *.rej *.elc *~ gnus gnus-[0-9] gnus-[0-9][0-9]
+ rm -f message message-[0-9]
+
+install:
+ cp gnus gnus-[0-9] gnus-[0-9][0-9] $(INFODIR)
+ cp message $(INFODIR)
+
+tmps:
+ if [ ! -d /local/tmp/larsi ]; then mkdir /local/tmp/larsi; fi
+ make screens
+ make herds
+ make etc
+ make piconss
+ make xfaces
+
+herds:
+ cd ps ; for i in new-herd-[0-9]*.gif; do echo $$i; giftoppm $$i | pnmcrop -white | pnmmargin -white 9 | pnmscale 2 | pnmsmooth -size 5 5 | ppmtopgm | pgmtops > ../tmp/`basename $$i .gif`.ps; done
+ cd ps ; giftoppm new-herd-section.gif | pnmscale 4 | pnmsmooth -size 11 11 | ppmtopgm | pgmtops > ../tmp/new-herd-section.ps
+
+screens:
+ cd screen ; for i in *.gif; do echo $$i; giftoppm $$i | pnmmargin -black 1 | ppmtopgm | pgmtops > ../tmp/`basename $$i .gif`.ps; done
+ giftoppm ps/larsi.gif | ppmtopgm | pgmtops > tmp/larsi.ps
+
+etc:
+ cd ../etc/gnus; for i in gnus-*.xpm; do echo $$i; xpmtoppm $$i | ppmtopgm | pgmtops > ../../texi/tmp/`basename $$i .xpm`.ps; done
+
+piconss:
+ cd picons; for i in *.xbm; do echo $$i; xbmtopbm $$i | pgmtops > ../tmp/picons-`basename $$i .xbm`.ps; done
+ cd picons; for i in *.gif; do echo $$i; giftoppm $$i | ppmtopgm | pgmtops > ../tmp/picons-`basename $$i .gif`.ps; done
+ for i in tmp/picons-*.ps; do echo "\\gnuspicon{$$i}"; done > picons.tmplatexi
+
+xfaces:
+ cd xface; for i in *.gif; do echo $$i; giftoppm $$i | ppmtopgm | pgmtops > ../tmp/xface-`basename $$i .gif`.ps; done
+ for i in tmp/xface-*.ps; do echo "\\gnusxface{$$i}"; done > xface.tmplatexi
--- /dev/null
+\input texinfo.tex
+
+@c %**start of header
+@setfilename custom
+@settitle The Customization Library
+@iftex
+@afourpaper
+@headings double
+@end iftex
+@c %**end of header
+
+@node Top, Introduction, (dir), (dir)
+@comment node-name, next, previous, up
+@top The Customization Library
+
+Version: 1.82
+
+@menu
+* Introduction::
+* User Commands::
+* The Customization Buffer::
+* Declarations::
+* Utilities::
+* The Init File::
+* Wishlist::
+@end menu
+
+@node Introduction, User Commands, Top, Top
+@comment node-name, next, previous, up
+@section Introduction
+
+This library allows customization of @dfn{user options}. Currently two
+types of user options are supported, namely @dfn{variables} and
+@dfn{faces}. Each user option can have four different values
+simultaneously:
+@table @dfn
+@item factory setting
+The value specified by the programmer.
+@item saved value
+The value saved by the user as the default for this variable. This
+overwrites the factory setting when starting a new emacs.
+@item current value
+The value used by Emacs. This will not be remembered next time you
+run Emacs.
+@item widget value
+The value entered by the user in a customization buffer, but not yet
+applied.
+@end table
+
+Variables also have a @dfn{type}, which specifies what kind of values
+the variable can hold, and how the value is presented in a customization
+buffer. By default a variable can hold any valid expression, but the
+programmer can specify a more limited type when declaring the variable.
+
+The user options are organized in a number of @dfn{groups}. Each group
+can contain a number user options, as well as other groups. The groups
+allows the user to concentrate on a specific part of emacs.
+
+@node User Commands, The Customization Buffer, Introduction, Top
+@comment node-name, next, previous, up
+@section User Commands
+
+The following commands will create a customization buffer:
+
+@table @code
+@item customize
+Create a customization buffer containing a specific group, by default
+the @code{emacs} group.
+
+@item customize-variable
+Create a customization buffer containing a single variable.
+
+@item customize-face
+Create a customization buffer containing a single face.
+
+@item customize-apropos
+Create a customization buffer containing all variables, faces, and
+groups that match a user specified regular expression.
+@end table
+
+@node The Customization Buffer, Declarations, User Commands, Top
+@comment node-name, next, previous, up
+@section The Customization Buffer.
+
+The customization buffer allows the user to make temporary or permanent
+changes to how specific aspects of emacs works, by setting and editing
+user options.
+
+The customization buffer contains three types of text:
+
+@table @dfn
+@item informative text
+where the normal editing commands are disabled.
+
+@item editable fields
+where you can edit with the usual emacs commands. Editable fields are
+usually displayed with a grey background if your terminal supports
+colors, or an italic font otherwise.
+
+@item buttons
+which can be activated by either pressing the @kbd{@key{ret}} while
+point is located on the text, or pushing @kbd{mouse-2} while the mouse
+pointer is above the tex. Buttons are usually displayed in a bold
+font.
+@end table
+
+You can move to the next the next editable field or button by pressing
+@kbd{@key{tab}} or the previous with @kbd{M-@key{tab}}. Some buttons
+have a small helpful message about their purpose, which will be
+displayed when you move to it with the @key{tab} key.
+
+The buffer is divided into three part, an introductory text, a list of
+customization options, and a line of customization buttons. Each part
+will be described in the following.
+
+@menu
+* The Introductory Text::
+* The Customization Options::
+* The Variable Options::
+* The Face Options::
+* The Group Options::
+* The State Button::
+* The Customization Buttons::
+@end menu
+
+@node The Introductory Text, The Customization Options, The Customization Buffer, The Customization Buffer
+@comment node-name, next, previous, up
+@subsection The Introductory Text
+
+The start of the buffer contains a short explanation of what it is, and
+how to get help. It will typically look like this:
+
+@example
+This is a customization buffer.
+Push RET or click mouse-2 on the word _help_ for more information.
+@end example
+
+Rather boring. It is mostly just informative text, but the word
+@samp{help} is a button that will bring up this document when
+activated.
+
+@node The Customization Options, The Variable Options, The Introductory Text, The Customization Buffer
+@comment node-name, next, previous, up
+@subsection The Customization Options
+
+Each customization option looks similar to the following text:
+
+@example
+ *** custom-background-mode: default
+ State: this item is unchanged from its factory setting.
+ [ ] [?] The brightness of the background.
+@end example
+
+The option contains the parts described below.
+
+@table @samp
+@item ***
+The Level Button. The customization options in the buffer are organized
+in a hierarchy, which is indicated by the number of stars in the level
+button. The top level options will be shown as @samp{*}. When they are
+expanded, the suboptions will be shown as @samp{**}. The example option
+is thus a subsuboption.
+
+Activating the level buttons will toggle between hiding and exposing the
+content of that option. The content can either be the value of the
+option, as in this example, or a list of suboptions.
+
+@item custom-background-mode
+This is the tag of the the option. The tag is a name of a variable, a
+face, or customization group. Activating the tag has an effect that
+depends on the exact type of the option. In this particular case,
+activating the tag will bring up a menu that will allow you to choose
+from the three possible values of the `custom-background-mode'
+variable.
+
+@item default
+After the tag, the options value is shown. Depending on its type, you
+may be able to edit the value directly. If an option should contain a
+file name, it is displayed in an editable field, i.e. you can edit it
+using the standard emacs editing commands.
+
+@item State: this item is unchanged from its factory setting.
+The state line. This line will explain the state of the option,
+e.g. whether it is currently hidden, or whether it has been modified or
+not. Activating the button will allow you to change the state, e.g. set
+or reset the changes you have made. This is explained in detail in the
+following sections.
+
+@item [ ]
+The magic button. This is an abbreviated version of the state line.
+
+@item [?]
+The documentation button. If the documentation is more than one line,
+this button will be present. Activating the button will toggle whether
+the complete documentation is shown, or only the first line.
+
+@item The brightness of the background.
+This is a documentation string explaining the purpose of this particular
+customization option.
+
+@end table
+
+@node The Variable Options, The Face Options, The Customization Options, The Customization Buffer
+@comment node-name, next, previous, up
+@subsection The Variable Options
+
+The most common customization options are emacs lisp variables. The
+actual editing of these variables depend on what type values the
+variable is expected to contain. For example, a lisp variable whose
+value should be a string will typically be represented with an editable
+text field in the buffer, where you can change the string directly. If
+the value is a list, each item in the list will be presented in the
+buffer buffer on a separate line, with buttons to insert new items in
+the list, or delete existing items from the list. You may want to see
+@ref{User Interface,,, widget, The Widget Library}, where some examples
+of editing are discussed.
+
+You can either choose to edit the value directly, or edit the lisp
+value for that variable. The lisp value is a lisp expression that
+will be evaluated when you start emacs. The result of the evaluation
+will be used as the initial value for that variable. Editing the
+lisp value is for experts only, but if the current value of the
+variable is of a wrong type (i.e. a symbol where a string is expected),
+the `edit lisp' mode will always be selected.
+
+You can see what mode is currently selected by looking at the state
+button. If it uses parenthesises (like @samp{( )}) it is in edit lisp
+mode, with square brackets (like @samp{[ ]}) it is normal edit mode.
+You can switch mode by activating the state button, and select either
+@samp{Edit} or @samp{Edit lisp} from the menu.
+
+You can change the state of the variable with the other menu items:
+
+@table @samp
+@item Set
+When you have made your modifications in the buffer, you need to
+activate this item to make the modifications take effect. The
+modifications will be forgotten next time you run emacs.
+
+@item Save
+Unless you activate this item instead! This will mark the modification
+as permanent, i.e. the changes will be remembered in the next emacs
+session.
+
+@item Reset
+If you have made some modifications and not yet applied them, you can
+undo the modification by activating this item.
+
+@item Reset to Saved
+Activating this item will reset the value of the variable to the last
+value you marked as permanent with `Save'.
+
+@item Reset to Factory Settings
+Activating this item will undo all modifications you have made, and
+reset the value to the initial value specified by the program itself.
+@end table
+
+By default, the value of large or complicated variables are hidden. You
+can show the value by clicking on the level button.
+
+@node The Face Options, The Group Options, The Variable Options, The Customization Buffer
+@comment node-name, next, previous, up
+@subsection The Face Options
+
+A face is an object that controls the appearance of some buffer text.
+The face has a number of possible attributes, such as boldness,
+foreground color, and more. For each attribute you can specify whether
+this attribute is controlled by the face, and if so, what the value is.
+For example, if the attribute bold is not controlled by a face, using
+that face on some buffer text will not affect its boldness. If the bold
+attribute is controlled by the face, it can be turned either on or of.
+
+It is possible to specify that a face should have different attributes
+on different device types. For example, a face may make text red on a
+color device, and bold on a monochrome device. You do this by
+activating `Edit All' in the state menu.
+
+The way this is presented in the customization buffer is to have a list
+of display specifications, and for each display specification a list of
+face attributes. For each face attribute, there is a checkbox
+specifying whether this attribute has effect and what the value is.
+Here is an example:
+
+@example
+ *** custom-invalid-face: (sample)
+ State: this item is unchanged from its factory setting.
+ [ ] Face used when the customize item is invalid.
+ [INS] [DEL] Display: [ ] Type: [ ] X [ ] PM [ ] Win32 [ ] DOS [ ] TTY
+ [X] Class: [X] Color [ ] Grayscale [ ] Monochrome
+ [ ] Background: [ ] Light [ ] Dark
+ Attributes: [ ] Bold: off
+ [ ] Italic: off
+ [ ] Underline: off
+ [X] Foreground: yellow (sample)
+ [X] Background: red (sample)
+ [ ] Stipple:
+ [INS] [DEL] Display: all
+ Attributes: [X] Bold: on
+ [X] Italic: on
+ [X] Underline: on
+ [ ] Foreground: default (sample)
+ [ ] Background: default (sample)
+ [ ] Stipple:
+ [INS]
+@end example
+
+This has two display specifications. The first will match all color
+displays, independently on what window system the device belongs to, and
+whether background color is dark or light. For devices matching this
+specification, @samp{custom-invalid-face} will force text to be
+displayed in yellow on red, but leave all other attributes alone.
+
+The second display will simply match everything. Since the list is
+prioritised, this means that it will match all non-color displays. For
+these, the face will not affect the foreground or background color, but
+force the font to be both bold, italic, and underline.
+
+You can add or delete display specifications by activating the
+@samp{[INS]} and @samp{[DEL]} buttons, and modify them by clicking on
+the check boxes. The first checkbox in each line in the display
+specification is special. It specify whether this particular property
+will even be relevant. By not checking the box in the first display, we
+match all device types, also device types other than those listed.
+
+After modifying the face, you can activate the state button to make the
+changes take effect. The menu items in the state button menu is similar
+to the state menu items for variables described in the previous section.
+
+@node The Group Options, The State Button, The Face Options, The Customization Buffer
+@comment node-name, next, previous, up
+@subsection The Group Options
+
+Since Emacs has approximately a zillion configuration options, they have
+been organized in groups. Each group can contain other groups, thus
+creating a customization hierarchy. The nesting of the customization
+within the visible part of this hierarchy is indicated by the number of
+stars in the level button.
+
+Since there is really no customization needed for the group itself, the
+menu items in the groups state button will affect all modified group
+members recursively. Thus, if you activate the @samp{Set} menu item,
+all variables and faces that have been modified and belong to that group
+will be applied. For those members that themselves are groups, it will
+work as if you had activated the @samp{Set} menu item on them as well.
+
+@node The State Button, The Customization Buttons, The Group Options, The Customization Buffer
+@comment node-name, next, previous, up
+@subsection The State Line and The Magic Button
+
+The state line has two purposes. The first is to hold the state menu,
+as described in the previous sections. The second is to indicate the
+state of each customization item.
+
+For the magic button, this is done by the character inside the brackets.
+The following states have been defined, the first that applies to the
+current item will be used:
+
+@table @samp
+@item -
+The option is currently hidden. For group options that means the
+members are not shown, for variables and faces that the value is not
+shown. You cannot perform any of the state change operations on a
+hidden customization option.
+
+@item *
+The value if this option has been modified in the buffer, but not yet
+applied.
+
+@item +
+The item has has been set by the user.
+
+@item :
+The current value of this option is different from the saved value.
+
+@item !
+The saved value of this option is different from the factory setting.
+
+@item @@
+The factory setting of this option is not known. This occurs when you
+try to customize variables or faces that have not been explicitly
+declared as customizable.
+
+@item SPC
+The factory setting is still in effect.
+
+@end table
+
+For non-hidden group options, the state shown is the most severe state
+of its members, where more severe means that it appears earlier in the
+list above (except hidden members, which are ignored).
+
+@node The Customization Buttons, , The State Button, The Customization Buffer
+@comment node-name, next, previous, up
+@subsection The Customization Buttons
+
+The last part of the customization buffer looks like this:
+
+@example
+[Set] [Save] [Reset] [Done]
+@end example
+
+Activating the @samp{[Set]}, @samp{[Save]}, or @samp{[Reset]}
+button will affect all modified customization items that are visible in
+the buffer. @samp{[Done]} will bury the buffer.
+
+@node Declarations, Utilities, The Customization Buffer, Top
+@comment node-name, next, previous, up
+@section Declarations
+
+This section describes how to declare customization groups, variables,
+and faces. It doesn't contain any examples, but please look at the file
+@file{cus-edit.el} which contains many declarations you can learn from.
+
+@menu
+* Declaring Groups::
+* Declaring Variables::
+* Declaring Faces::
+* Usage for Package Authors::
+@end menu
+
+All the customization declarations can be changes by keyword arguments.
+Groups, variables, and faces all share these common keywords:
+
+@table @code
+@item :group
+@var{value} should be a customization group.
+Add @var{symbol} to that group.
+@item :link
+@var{value} should be a widget type.
+Add @var{value} to the extrenal links for this customization option.
+Useful widget types include @code{custom-manual}, @code{info-link}, and
+@code{url-link}.
+@item :load
+Add @var{value} to the files that should be loaded nefore displaying
+this customization option. The value should be iether a string, which
+should be a string which will be loaded with @code{load-library} unless
+present in @code{load-history}, or a symbol which will be loaded with
+@code{require}.
+@item :tag
+@var{Value} should be a short string used for identifying the option in
+customization menus and buffers. By default the tag will be
+automatically created from the options name.
+@end table
+
+@node Declaring Groups, Declaring Variables, Declarations, Declarations
+@comment node-name, next, previous, up
+@subsection Declaring Groups
+
+Use @code{defgroup} to declare new customization groups.
+
+@defun defgroup symbol members doc [keyword value]...
+Declare @var{symbol} as a customization group containing @var{members}.
+@var{symbol} does not need to be quoted.
+
+@var{doc} is the group documentation.
+
+@var{members} should be an alist of the form ((@var{name}
+@var{widget})...) where @var{name} is a symbol and @var{widget} is a
+widget for editing that symbol. Useful widgets are
+@code{custom-variable} for editing variables, @code{custom-face} for
+editing faces, and @code{custom-group} for editing groups.@refill
+
+Internally, custom uses the symbol property @code{custom-group} to keep
+track of the group members, and @code{group-documentation} for the
+documentation string.
+
+The following additional @var{keyword}'s are defined:
+
+@table @code
+@item :prefix
+@var{value} should be a string. If the string is a prefix for the name
+of a member of the group, that prefix will be ignored when creating a
+tag for that member.
+@end table
+@end defun
+
+@node Declaring Variables, Declaring Faces, Declaring Groups, Declarations
+@comment node-name, next, previous, up
+@subsection Declaring Variables
+
+Use @code{defcustom} to declare user editable variables.
+
+@defun defcustom symbol value doc [keyword value]...
+Declare @var{symbol} as a customizable variable that defaults to @var{value}.
+Neither @var{symbol} nor @var{value} needs to be quoted.
+If @var{symbol} is not already bound, initialize it to @var{value}.
+
+@var{doc} is the variable documentation.
+
+The following additional @var{keyword}'s are defined:
+
+@table @code
+@item :type
+@var{value} should be a widget type.
+@item :options
+@var{value} should be a list of possible members of the specified type.
+For hooks, this is a list of function names.
+@end table
+
+@xref{Sexp Types,,,widget,The Widget Library}, for information about
+widgets to use together with the @code{:type} keyword.
+@end defun
+
+Internally, custom uses the symbol property @code{custom-type} to keep
+track of the variables type, @code{factory-value} for the program
+specified default value, @code{saved-value} for a value saved by the
+user, and @code{variable-documentation} for the documentation string.
+
+Use @code{custom-add-option} to specify that a specific function is
+useful as an meber of a hook.
+
+@defun custom-add-option symbol option
+To the variable @var{symbol} add @var{option}.
+
+If @var{symbol} is a hook variable, @var{option} should be a hook
+member. For other types variables, the effect is undefined."
+@end defun
+
+@node Declaring Faces, Usage for Package Authors, Declaring Variables, Declarations
+@comment node-name, next, previous, up
+@subsection Declaring Faces
+
+Faces are declared with @code{defface}.
+
+@defun defface face spec doc [keyword value]...
+
+Declare @var{face} as a customizable face that defaults to @var{spec}.
+@var{face} does not need to be quoted.
+
+If @var{face} has been set with `custom-set-face', set the face attributes
+as specified by that function, otherwise set the face attributes
+according to @var{spec}.
+
+@var{doc} is the face documentation.
+
+@var{spec} should be an alist of the form @samp{((@var{display} @var{atts})...)}.
+
+@var{atts} is a list of face attributes and their values. The possible
+attributes are defined in the variable `custom-face-attributes'.
+Alternatively, @var{atts} can be a face in which case the attributes of
+that face is used.
+
+The @var{atts} of the first entry in @var{spec} where the @var{display}
+matches the frame should take effect in that frame. @var{display} can
+either be the symbol `t', which will match all frames, or an alist of
+the form @samp{((@var{req} @var{item}...)...)}@refill
+
+For the @var{display} to match a FRAME, the @var{req} property of the
+frame must match one of the @var{item}. The following @var{req} are
+defined:@refill
+
+@table @code
+@item type
+(the value of (window-system))@*
+Should be one of @code{x} or @code{tty}.
+
+@item class
+(the frame's color support)@*
+Should be one of @code{color}, @code{grayscale}, or @code{mono}.
+
+@item background
+(what color is used for the background text)@*
+Should be one of @code{light} or @code{dark}.
+@end table
+
+Internally, custom uses the symbol property @code{factory-face} for the
+program specified default face properties, @code{saved-face} for
+properties saved by the user, and @code{face-doc-string} for the
+documentation string.@refill
+
+@end defun
+
+@node Usage for Package Authors, , Declaring Faces, Declarations
+@comment node-name, next, previous, up
+@subsection Usage for Package Authors
+
+The recommended usage for the author of a typical emacs lisp package is
+to create one group identifying the package, and make all user options
+and faces members of that group. If the package has more than around 20
+such options, they should be divided into a number of subgroups, with
+each subgroup being member of the top level group.
+
+The top level group for the package should itself be member of one or
+more of the standard customization groups. There exists a group for
+each @emph{finder} keyword. Press @kbd{C-c p} to see a list of finder
+keywords, and add you group to each of them, using the @code{:group}
+keyword.
+
+@node Utilities, The Init File, Declarations, Top
+@comment node-name, next, previous, up
+@section Utilities
+
+These utilities can come in handy when adding customization support.
+
+@deffn Widget custom-manual
+Widget type for specifying the info manual entry for a customization
+option. It takes one argument, an info address.
+@end deffn
+
+@defun custom-add-to-group group member widget
+To existing @var{group} add a new @var{member} of type @var{widget},
+If there already is an entry for that member, overwrite it.
+@end defun
+
+@defun custom-add-link symbol widget
+To the custom option @var{symbol} add the link @var{widget}.
+@end defun
+
+@defun custom-add-load symbol load
+To the custom option @var{symbol} add the dependency @var{load}.
+@var{load} should be either a library file name, or a feature name.
+@end defun
+
+@defun custom-menu-create symbol &optional name
+Create menu for customization group @var{symbol}.
+If optional @var{name} is given, use that as the name of the menu.
+Otherwise make up a name from @var{symbol}.
+The menu is in a format applicable to @code{easy-menu-define}.
+@end defun
+
+@node The Init File, Wishlist, Utilities, Top
+@comment node-name, next, previous, up
+@section The Init File
+
+When you save the customizations, call to @code{custom-set-variables},
+@code{custom-set-faces} are inserted into the file specified by
+@code{custom-file}. By default @code{custom-file} is your @file{.emacs}
+file. If you use another file, you must explicitly load it yourself.
+The two functions will initialize variables and faces as you have
+specified.
+
+@node Wishlist, , The Init File, Top
+@comment node-name, next, previous, up
+@section Wishlist
+
+@itemize @bullet
+@item
+The menu items should be grayed out when the information is
+missing. I.e. if a variable doesn't have a factory setting, the user
+should not be allowed to select the @samp{Factory} menu item.
+
+@item
+Better support for keyboard operations in the customize buffer.
+
+@item
+Integrate with @file{w3} so you can customization buffers with much
+better formatting. I'm thinking about adding a <custom>name</custom>
+tag. The latest w3 have some support for this, so come up with a
+convincing example.
+
+@item
+Add an `examples' section, with explained examples of custom type
+definitions.
+
+@item
+Support selectable color themes. I.e., change many faces by setting one
+variable.
+
+@item
+Support undo using lmi's @file{gnus-undo.el}.
+
+@item
+Make it possible to append to `choice', `radio', and `set' options.
+
+@item
+Make it possible to customize code, for example to enable or disable a
+global minor mode.
+
+@item
+Ask whether set or modified variables should be saved in
+@code{kill-buffer-hook}.
+
+Ditto for @code{kill-emacs-query-functions}.
+
+@item
+Command to check if there are any customization options that
+does not belong to an existing group.
+
+@item
+Optionally disable the point-cursor and instead highlight the selected
+item in XEmacs. This is like the *Completions* buffer in XEmacs.
+Suggested by Jens Lautenbacher
+@samp{<jens@@lemming0.lem.uni-karlsruhe.de>}.@refill
+
+@item
+Empty customization groups should start open (harder than it looks).
+
+@item
+Make it possible to include a comment/remark/annotation when saving an
+option.
+
+@end itemize
+
+@contents
+@bye
--- /dev/null
+\input texinfo
+@c -*-texinfo-*-
+@c Copyright (C) 1995 Free Software Foundation, Inc.
+@setfilename gnus-faq.info
+
+@node Frequently Asked Questions
+@section Frequently Asked Questions
+
+This is the Gnus Frequently Asked Questions list.
+If you have a Web browser, the official hypertext version is at
+@file{http://www.ccs.neu.edu/software/gnus/}, and has
+probably been updated since you got this manual.
+
+@menu
+* Installation FAQ:: Installation of Gnus.
+* Customization FAQ:: Customizing Gnus.
+* Reading News FAQ:: News Reading Questions.
+* Reading Mail FAQ:: Mail Reading Questions.
+@end menu
+
+
+@node Installation FAQ
+@subsection Installation
+
+@itemize @bullet
+@item
+Q1.1 What is the latest version of Gnus?
+
+The latest (and greatest) version is 5.0.10. You might also run
+across something called @emph{September Gnus}. September Gnus
+is the alpha version of the next major release of Gnus. It is currently
+not stable enough to run unless you are prepared to debug lisp.
+
+@item
+Q1.2 Where do I get Gnus?
+
+Any of the following locations:
+
+@itemize @minus
+@item
+@file{ftp://ftp.ifi.uio.no/pub/emacs/gnus/gnus.tar.gz}
+
+@item
+@file{ftp://ftp.pilgrim.umass.edu/pub/misc/ding/}
+
+@item
+@file{gopher://gopher.pilgrim.umass.edu/11/pub/misc/ding/}
+
+@item
+@file{ftp://aphrodite.nectar.cs.cmu.edu/pub/ding-gnus/}
+
+@item
+@file{ftp://ftp.solace.mh.se:/pub/gnu/elisp/}
+
+@end itemize
+
+@item
+Q1.3 Which version of Emacs do I need?
+
+At least GNU Emacs 19.28, or XEmacs 19.12 is recommended. GNU Emacs
+19.25 has been reported to work under certain circumstances, but it
+doesn't @emph{officially} work on it. 19.27 has also been reported to
+work. Gnus has been reported to work under OS/2 as well as Unix.
+
+
+@item
+Q1.4 Where is timezone.el?
+
+Upgrade to XEmacs 19.13. In earlier versions of XEmacs this file was
+placed with Gnus 4.1.3, but that has been corrected.
+
+
+@item
+Q1.5 When I run Gnus on XEmacs 19.13 I get weird error messages.
+
+You're running an old version of Gnus. Upgrade to at least version
+5.0.4.
+
+
+@item
+Q1.6 How do I unsubscribe from the Mailing List?
+
+Send an e-mail message to @file{ding-request@@ifi.uio.no} with the magic word
+@emph{unsubscribe} somewhere in it, and you will be removed.
+
+If you are reading the digest version of the list, send an e-mail message
+to @*
+@file{ding-rn-digests-d-request@@moe.shore.net}
+with @emph{unsubscribe} as the subject and you will be removed.
+
+
+@item
+Q1.7 How do I run Gnus on both Emacs and XEmacs?
+
+The basic answer is to byte-compile under XEmacs, and then you can
+run under either Emacsen. There is, however, a potential version
+problem with easymenu.el with Gnu Emacs prior to 19.29.
+
+Per Abrahamsen <abraham@@dina.kvl.dk> writes :@*
+The internal easymenu.el interface changed between 19.28 and 19.29 in
+order to make it possible to create byte compiled files that can be
+shared between Gnu Emacs and XEmacs. The change is upward
+compatible, but not downward compatible.
+This gives the following compatibility table:
+
+@example
+Compiled with: | Can be used with:
+----------------+--------------------------------------
+19.28 | 19.28 19.29
+19.29 | 19.29 XEmacs
+XEmacs | 19.29 XEmacs
+@end example
+
+If you have Gnu Emacs 19.28 or earlier, or XEmacs 19.12 or earlier, get
+a recent version of auc-menu.el from
+@file{ftp://ftp.iesd.auc.dk/pub/emacs-lisp/auc-menu.el}, and install it
+under the name easymenu.el somewhere early in your load path.
+
+
+@item
+Q1.8 What resources are available?
+
+There is the newsgroup Gnu.emacs.gnus. Discussion of Gnus 5.x is now
+taking place there. There is also a mailing list, send mail to
+@file{ding-request@@ifi.uio.no} with the magic word @emph{subscribe}
+somewhere in it.
+
+@emph{NOTE:} the traffic on this list is heavy so you may not want to be
+on it (unless you use Gnus as your mailer reader, that is). The mailing
+list is mainly for developers and testers.
+
+Gnus has a home World Wide Web page at@*
+@file{http://www.ifi.uio.no/~larsi/ding.html}.
+
+Gnus has a write up in the X Windows Applications FAQ at@*
+@file{http://www.ee.ryerson.ca:8080/~elf/xapps/Q-III.html}.
+
+The Gnus manual is also available on the World Wide Web. The canonical
+source is in Norway at@*
+@file{http://www.ifi.uio.no/~larsi/ding-manual/gnus_toc.html}.
+
+There are three mirrors in the United States:
+@enumerate
+@item
+@file{http://www.miranova.com/gnus-man/}
+
+@item
+@file{http://www.pilgrim.umass.edu/pub/misc/ding/manual/gnus_toc.html}
+
+@item
+@file{http://www.rtd.com/~woo/gnus/}
+
+@end enumerate
+
+PostScript copies of the Gnus Reference card are available from@*
+@file{ftp://ftp.cs.ualberta.ca/pub/oolog/gnus/}. They are mirrored at@*
+@file{ftp://ftp.pilgrim.umass.edu/pub/misc/ding/refcard/} in the
+United States. And@*
+@file{ftp://marvin.fkphy.uni-duesseldorf.de/pub/gnus/}
+in Germany.
+
+An online version of the Gnus FAQ is available at@*
+@file{http://www.miranova.com/~steve/gnus-faq.html}. Off-line formats
+are also available:@*
+ASCII: @file{ftp://ftp.miranova.com/pub/gnus/gnus-faq}@*
+PostScript: @file{ftp://ftp.miranova.com/pub/gnus/gnus-faq.ps}.
+
+
+@item
+Q1.9 Gnus hangs on connecting to NNTP server
+
+I am running XEmacs on SunOS and Gnus prints a message about Connecting
+to NNTP server and then just hangs.
+
+Ben Wing <wing@@netcom.com> writes :@*
+I wonder if you're hitting the infamous @emph{libresolv} problem.
+The basic problem is that under SunOS you can compile either
+with DNS or NIS name lookup libraries but not both. Try
+substituting the IP address and see if that works; if so, you
+need to download the sources and recompile.
+
+
+@item
+Q1.10 Mailcrypt 3.4 doesn't work
+
+This problem is verified to still exist in Gnus 5.0.9 and Mailcrypt 3.4.
+The answer comes from Peter Arius
+<arius@@immd2.informatik.uni-erlangen.de>.
+
+I found out that mailcrypt uses
+@code{gnus-eval-in-buffer-window}, which is a macro.
+It seems as if you have
+compiled mailcrypt with plain old GNUS in load path, and the XEmacs byte
+compiler has inserted that macro definition into
+@file{mc-toplev.elc}.
+The solution is to recompile @file{mc-toplev.el} with Gnus 5 in
+load-path, and it works fine.
+
+Steve Baur <steve@@miranova.com> adds :@*
+The problem also manifests itself if neither GNUS 4 nor Gnus 5 is in the
+load-path.
+
+
+@item
+Q1.11 What other packages work with Gnus?
+
+@itemize @minus
+@item
+Mailcrypt.
+
+Mailcrypt is an Emacs interface to PGP. It works, it installs
+without hassle, and integrates very easily. Mailcrypt can be
+obtained from@*
+@file{ftp://cag.lcs.mit.edu/pub/patl/mailcrypt-3.4.tar.gz}.
+
+@item
+Tools for Mime.
+
+Tools for Mime is an Emacs MUA interface to MIME. Installation is
+a two-step process unlike most other packages, so you should
+be prepared to move the byte-compiled code somewhere. There
+are currently two versions of this package available. It can
+be obtained from@*
+@file{ftp://ftp.jaist.ac.jp/pub/GNU/elisp/}.
+Be sure to apply the supplied patch. It works with Gnus through
+version 5.0.9. In order for all dependencies to work correctly
+the load sequence is as follows:
+@lisp
+ (load "tm-setup")
+ (load "gnus")
+ (load "mime-compose")
+@end lisp
+
+@emph{NOTE:} Loading the package disables citation highlighting by
+default. To get the old behavior back, use the @kbd{M-t} command.
+
+@end itemize
+
+@end itemize
+
+
+@node Customization FAQ
+@subsection Customization
+
+@itemize @bullet
+@item
+Q2.1 Custom Edit does not work under XEmacs
+
+The custom package has not been ported to XEmacs.
+
+
+@item
+Q2.2 How do I quote messages?
+
+I see lots of messages with quoted material in them. I am wondering
+how to have Gnus do it for me.
+
+This is Gnus, so there are a number of ways of doing this. You can use
+the built-in commands to do this. There are the @kbd{F} and @kbd{R}
+keys from the summary buffer which automatically include the article
+being responded to. These commands are also selectable as @i{Followup
+and Yank} and @i{Reply and Yank} in the Post menu.
+
+@kbd{C-c C-y} grabs the previous message and prefixes each line with
+@code{ail-indentation-spaces} spaces or @code{mail-yank-prefix} if that is
+non-nil, unless you have set your own @code{mail-citation-hook}, which will
+be called to do the job.
+
+You might also consider the Supercite package, which allows for pretty
+arbitrarily complex quoting styles. Some people love it, some people
+hate it.
+
+
+@item
+Q2.3 How can I keep my nnvirtual:* groups sorted?
+
+How can I most efficiently arrange matters so as to keep my nnvirtual:*
+(etc) groups at the top of my group selection buffer, whilst keeping
+everything sorted in alphabetical order.
+
+If you don't subscribe often to new groups then the easiest way is to
+first sort the groups and then manually kill and yank the virtuals
+wherever you want them.
+
+
+@item
+Q2.4 Any good suggestions on stuff for an all.SCORE file?
+
+Here is a collection of suggestions from the Gnus mailing list.
+
+@enumerate
+@item
+From ``Dave Disser'' <disser@@sdd.hp.com>@*
+I like blasting anything without lowercase letters. Weeds out most of
+the make $$ fast, as well as the lame titles like ``IBM'' and ``HP-UX''
+with no further description.
+@lisp
+ (("Subject"
+ ("^\\(Re: \\)?[^a-z]*$" -200 nil R)))
+@end lisp
+
+@item
+From ``Peter Arius'' <arius@@immd2.informatik.uni-erlangen.de>@*
+The most vital entries in my (still young) all.SCORE:
+@lisp
+(("xref"
+ ("alt.fan.oj-simpson" -1000 nil s))
+ ("subject"
+ ("\\<\\(make\\|fast\\|big\\)\\s-*\\(money\\|cash\\|bucks?\\)\\>" -1000 nil r)
+ ("$$$$" -1000 nil s)))
+@end lisp
+
+@item
+From ``Per Abrahamsen'' <abraham@@dina.kvl.dk>@*
+@lisp
+(("subject"
+ ;; CAPS OF THE WORLD, UNITE
+ ("^..[^a-z]+$" -1 nil R)
+ ;; $$$ Make Money $$$ (Try work)
+ ("$" -1 nil s)
+ ;; I'm important! And I have exclamation marks to prove it!
+ ("!" -1 nil s)))
+@end lisp
+
+@item
+From ``heddy boubaker'' <boubaker@@cenatls.cena.dgac.fr>@*
+I would like to contribute with mine.
+@lisp
+(
+ (read-only t)
+ ("subject"
+ ;; ALL CAPS SUBJECTS
+ ("^\\([Rr][Ee]: +\\)?[^a-z]+$" -1 nil R)
+ ;; $$$ Make Money $$$
+ ("$$" -10 nil s)
+ ;; Empty subjects are worthless!
+ ("^ *\\([(<]none[>)]\\|(no subject\\( given\\)?)\\)? *$" -10 nil r)
+ ;; Sometimes interesting announces occur!
+ ("ANN?OU?NC\\(E\\|ING\\)" +10 nil r)
+ ;; Some people think they're on mailing lists
+ ("\\(un\\)?sub?scribe" -100 nil r)
+ ;; Stop Micro$oft NOW!!
+ ("\\(m\\(icro\\)?[s$]\\(oft\\|lot\\)?-?\\)?wind?\\(ows\\|aube\\|oze\\)?[- ]*\\('?95\\|NT\\|3[.]1\\|32\\)" -1001 nil r)
+ ;; I've nothing to buy
+ ("\\(for\\|4\\)[- ]*sale" -100 nil r)
+ ;; SELF-DISCIPLINED people
+ ("\\[[^a-z0-9 \t\n][^a-z0-9 \t\n]\\]" +100 nil r)
+ )
+ ("from"
+ ;; To keep track of posters from my site
+ (".dgac.fr" +1000 nil s))
+ ("followup"
+ ;; Keep track of answers to my posts
+ ("boubaker" +1000 nil s))
+ ("lines"
+ ;; Some people have really nothing to say!!
+ (1 -10 nil <=))
+ (mark -100)
+ (expunge -1000)
+ )
+@end lisp
+
+@item
+From ``Christopher Jones'' <cjones@@au.oracle.com>@*
+The sample @file{all.SCORE} files from Per and boubaker could be
+augmented with:
+@lisp
+ (("subject"
+ ;; No junk mail please!
+ ("please ignore" -500 nil s)
+ ("test" -500 nil e))
+ )
+@end lisp
+
+@item
+From ``Brian Edmonds'' <edmonds@@cs.ubc.ca>@*
+Augment any of the above with a fast method of scoring down
+excessively cross posted articles.
+@lisp
+ ("xref"
+ ;; the more cross posting, the exponentially worse the article
+ ("^xref: \\S-+ \\S-+ \\S-+ \\S-+" -1 nil r)
+ ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -2 nil r)
+ ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -4 nil r)
+ ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -8 nil r)
+ ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -16 nil r)
+ ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -32 nil r)
+ ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -64 nil r)
+ ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -128 nil r)
+ ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -256 nil r)
+ ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -512 nil r))
+@end lisp
+
+@end enumerate
+
+
+@item
+Q2.5 What do I use to yank-through when replying?
+
+You should probably reply and followup with @kbd{R} and @kbd{F}, instead
+of @kbd{r} and @kbd{f}, which solves your problem. But you could try
+something like:
+
+@example
+(defconst mail-yank-ignored-headers
+ "^.*:"
+ "Delete these headers from old message when it's inserted in a reply.")
+@end example
+
+
+@item
+Q2.6 I don't like the default WWW browser
+
+Now when choosing an URL Gnus starts up a W3 buffer, I would like it
+to always use Netscape (I don't browse in text-mode ;-).
+
+@enumerate
+@item
+Activate `Customize...' from the `Help' menu.
+
+@item
+Scroll down to the `WWW Browser' field.
+
+@item
+Click `mouse-2' on `WWW Browser'.
+
+@item
+Select `Netscape' from the pop up menu.
+
+@item
+Press `C-c C-c'
+
+@end enumerate
+
+If you are using XEmacs then to specify Netscape do
+@lisp
+ (setq gnus-button-url 'gnus-netscape-open-url)
+@end lisp
+
+
+@item
+Q2.7 What, if any, relation is between ``ask-server'' and ``(setq
+gnus-read-active-file 'some)''?
+
+In order for Gnus to show you the complete list of newsgroups, it will
+either have to either store the list locally, or ask the server to
+transmit the list. You enable the first with
+
+@lisp
+ (setq gnus-save-killed-list t)
+@end lisp
+
+and the second with
+
+@lisp
+ (setq gnus-read-active-file t)
+@end lisp
+
+If both are disabled, Gnus will not know what newsgroups exists. There
+is no option to get the list by casting a spell.
+
+
+@item
+Q2.8 Moving between groups is slow.
+
+Per Abrahamsen <abraham@@dina.kvl.dk> writes:@*
+
+Do you call @code{define-key} or something like that in one of the
+summary mode hooks? This would force Emacs to recalculate the keyboard
+shortcuts. Removing the call should speed up @kbd{M-x gnus-summary-mode
+RET} by a couple of orders of magnitude. You can use
+
+@lisp
+(define-key gnus-summary-mode-map KEY COMMAND)
+@end lisp
+
+in your @file{.gnus} instead.
+
+@end itemize
+
+
+@node Reading News FAQ
+@subsection Reading News
+
+@itemize @bullet
+@item
+Q3.1 How do I convert my kill files to score files?
+
+A kill-to-score translator was written by Ethan Bradford
+<ethanb@@ptolemy.astro.washington.edu>. It is available from@*
+@file{http://baugi.ifi.uio.no/~larsi/ding-various/gnus-kill-to-score.el}.
+
+
+@item
+Q3.2 My news server has a lot of groups, and killing groups is painfully
+slow.
+
+Don't do that then. The best way to get rid of groups that should be
+dead is to edit your newsrc directly. This problem will be addressed
+in the near future.
+
+
+@item
+Q3.3 How do I use an NNTP server with authentication?
+
+Put the following into your .gnus:
+@lisp
+ (add-hook 'nntp-server-opened-hook 'nntp-send-authinfo)
+@end lisp
+
+
+@item
+Q3.4 Not reading the first article.
+
+How do I avoid reading the first article when a group is selected?
+
+@enumerate
+@item
+Use @kbd{RET} to select the group instead of @kbd{SPC}.
+
+@item
+@code{(setq gnus-auto-select first nil)}
+
+@item
+Luis Fernandes <elf@@mailhost.ee.ryerson.ca>writes:@*
+This is what I use...customize as necessary...
+
+@lisp
+;;; Don't auto-select first article if reading sources, or archives or
+;;; jobs postings, etc. and just display the summary buffer
+(add-hook 'gnus-select-group-hook
+ (function
+ (lambda ()
+ (cond ((string-match "sources" gnus-newsgroup-name)
+ (setq gnus-auto-select-first nil))
+ ((string-match "jobs" gnus-newsgroup-name)
+ (setq gnus-auto-select-first nil))
+ ((string-match "comp\\.archives" gnus-newsgroup-name)
+ (setq gnus-auto-select-first nil))
+ ((string-match "reviews" gnus-newsgroup-name)
+ (setq gnus-auto-select-first nil))
+ ((string-match "announce" gnus-newsgroup-name)
+ (setq gnus-auto-select-first nil))
+ ((string-match "binaries" gnus-newsgroup-name)
+ (setq gnus-auto-select-first nil))
+ (t
+ (setq gnus-auto-select-first t))))))
+@end lisp
+
+@item
+Per Abrahamsen <abraham@@dina.kvl.dk> writes:@*
+Another possibility is to create an @file{all.binaries.all.SCORE} file
+like this:
+
+@lisp
+((local
+ (gnus-auto-select-first nil)))
+@end lisp
+
+and insert
+@lisp
+ (setq gnus-auto-select-first t)
+@end lisp
+
+in your @file{.gnus}.
+
+@end enumerate
+
+@item
+Q3.5 Why aren't BBDB known posters marked in the summary buffer?
+
+Brian Edmonds <edmonds@@cs.ubc.ca> writes:@*
+Due to changes in Gnus 5.0, @file{bbdb-gnus.el} no longer marks known
+posters in the summary buffer. An updated version, @file{gnus-bbdb.el}
+is available at the locations listed below. This package also supports
+autofiling of incoming mail to folders specified in the BBDB. Extensive
+instructions are included as comments in the file.
+
+Send mail to @file{majordomo@@edmonds.home.cs.ubc.ca} with the following
+line in the body of the message: @emph{get misc gnus-bbdb.el}.
+
+Or get it from the World Wide Web:@*
+@file{http://www.cs.ubc.ca/spider/edmonds/gnus-bbdb.el}.
+
+@end itemize
+
+
+@node Reading Mail FAQ
+@subsection Reading Mail
+
+@itemize @bullet
+@item
+Q4.1 What does the message ``Buffer has changed on disk'' mean in a mail
+group?
+
+Your filter program should not deliver mail directly to your folders,
+instead it should put the mail into spool files. Gnus will then move
+the mail safely from the spool files into the folders. This will
+eliminate the problem. Look it up in the manual, in the section
+entitled ``Mail & Procmail''.
+
+
+@item
+Q4.2 How do you make articles un-expirable?
+
+I am using nnml to read news and have used
+@code{gnus-auto-expirable-newsgroups} to automagically expire articles
+in some groups (Gnus being one of them). Sometimes there are
+interesting articles in these groups that I want to keep. Is there any
+way of explicitly marking an article as un-expirable - that is mark it
+as read but not expirable?
+
+Use @kbd{u}, @kbd{!}, @kbd{d} or @kbd{M-u} in the summary buffer. You
+just remove the @kbd{E} mark by setting some other mark. It's not
+necessary to tick the articles.
+
+
+@item
+Q4.3 How do I delete bogus nnml: groups?
+
+My problem is that I have various mail (nnml) groups generated while
+experimenting with Gnus. How do I remove them now? Setting the level to
+9 does not help. Also @code{gnus-group-check-bogus-groups} does not
+recognize them.
+
+Removing mail groups is tricky at the moment. (It's on the to-do list,
+though.) You basically have to kill the groups in Gnus, shut down Gnus,
+edit the active file to exclude these groups, and probably remove the
+nnml directories that contained these groups as well. Then start Gnus
+back up again.
+
+
+@item
+Q4.4 What happened to my new mail groups?
+
+I got new mail, but I have
+never seen the groups they should have been placed in.
+
+They are probably there, but as zombies. Press @kbd{A z} to list
+zombie groups, and then subscribe to the groups you want with @kbd{u}.
+This is all documented quite nicely in the user's manual.
+
+
+@item
+Q4.5 Not scoring mail groups
+
+How do you @emph{totally} turn off scoring in mail groups?
+
+Use an nnbabyl:all.SCORE (or nnmh, or nnml, or whatever) file containing:
+
+@example
+((adapt ignore)
+ (local (gnus-use-scoring nil))
+ (exclude-files "all.SCORE"))
+@end example
+
+@end itemize
+
+
--- /dev/null
+\input texinfo @c -*-texinfo-*-
+
+@setfilename gnus
+@settitle Quassia Gnus 0.110 Manual
+@synindex fn cp
+@synindex vr cp
+@synindex pg cp
+@iftex
+@finalout
+@end iftex
+@setchapternewpage odd
+
+@iftex
+@iflatex
+\documentclass[twoside,a4paper,openright,11pt]{book}
+\usepackage[latin1]{inputenc}
+\usepackage{pagestyle}
+\usepackage{epsfig}
+\usepackage{bembo}
+
+\makeindex
+\begin{document}
+
+\newcommand{\gnuschaptername}{}
+\newcommand{\gnussectionname}{}
+
+\newcommand{\gnusbackslash}{/}
+
+\newcommand{\gnusxref}[1]{See ``#1'' on page \pageref{#1}}
+\newcommand{\gnuspxref}[1]{see ``#1'' on page \pageref{#1}}
+
+\newcommand{\gnuskindex}[1]{\index{#1}}
+\newcommand{\gnusindex}[1]{\index{#1}}
+
+\newcommand{\gnustt}[1]{{\fontfamily{pfu}\fontsize{10pt}{10}\selectfont #1}}
+\newcommand{\gnuscode}[1]{\gnustt{#1}}
+\newcommand{\gnussamp}[1]{``{\fontencoding{OT1}\fontfamily{pcr}\fontsize{10pt}{10}\selectfont #1}''}
+\newcommand{\gnuslisp}[1]{\gnustt{#1}}
+\newcommand{\gnuskbd}[1]{`\gnustt{#1}'}
+\newcommand{\gnusfile}[1]{`\gnustt{#1}'}
+\newcommand{\gnusdfn}[1]{\textit{#1}}
+\newcommand{\gnusi}[1]{\textit{#1}}
+\newcommand{\gnusstrong}[1]{\textbf{#1}}
+\newcommand{\gnusemph}[1]{\textit{#1}}
+\newcommand{\gnusvar}[1]{{\fontsize{10pt}{10}\selectfont\textsl{\textsf{#1}}}}
+\newcommand{\gnussc}[1]{\textsc{#1}}
+\newcommand{\gnustitle}[1]{{\huge\textbf{#1}}}
+\newcommand{\gnusauthor}[1]{{\large\textbf{#1}}}
+
+\newcommand{\gnusbullet}{{${\bullet}$}}
+\newcommand{\gnusdollar}{\$}
+\newcommand{\gnusampersand}{\&}
+\newcommand{\gnuspercent}{\%}
+\newcommand{\gnushash}{\#}
+\newcommand{\gnushat}{\symbol{"5E}}
+\newcommand{\gnusunderline}{\symbol{"5F}}
+\newcommand{\gnusnot}{$\neg$}
+\newcommand{\gnustilde}{\symbol{"7E}}
+\newcommand{\gnusless}{{$<$}}
+\newcommand{\gnusgreater}{{$>$}}
+
+\newcommand{\gnushead}{\raisebox{-1cm}{\epsfig{figure=gnus-head.eps,height=1cm}}}
+\newcommand{\gnusinteresting}{
+\marginpar[\mbox{}\hfill\gnushead]{\gnushead}
+}
+
+\newcommand{\gnuscleardoublepage}{\ifodd\count0\mbox{}\clearpage\thispagestyle{empty}\mbox{}\clearpage\else\clearpage\fi}
+
+\newcommand{\gnuspagechapter}[1]{
+{\mbox{}}
+}
+
+\newdimen{\gnusdimen}
+\gnusdimen 0pt
+
+\newcommand{\gnuschapter}[2]{
+\gnuscleardoublepage
+\ifdim \gnusdimen = 0pt\setcounter{page}{1}\pagestyle{gnus}\pagenumbering{arabic} \gnusdimen 1pt\fi
+\chapter{#2}
+\renewcommand{\gnussectionname}{}
+\renewcommand{\gnuschaptername}{#2}
+\thispagestyle{empty}
+\hspace*{-2cm}
+\begin{picture}(500,500)(0,0)
+\put(480,350){\makebox(0,0)[tr]{#1}}
+\put(40,300){\makebox(500,50)[bl]{{\Huge\bf{#2}}}}
+\end{picture}
+\clearpage
+}
+
+\newcommand{\gnusfigure}[3]{
+\begin{figure}
+\mbox{}\ifodd\count0\hspace*{-0.8cm}\else\hspace*{-3cm}\fi\begin{picture}(440,#2)
+#3
+\end{picture}
+\caption{#1}
+\end{figure}
+}
+
+\newcommand{\gnusicon}[1]{
+\marginpar[\mbox{}\hfill\raisebox{-1.5cm}{\epsfig{figure=tmp/#1-up.ps,height=1.5cm}}]{\raisebox{-1cm}{\epsfig{figure=tmp/#1-up.ps,height=1cm}}}
+}
+
+\newcommand{\gnuspicon}[1]{
+\marginpar[\mbox{}\hfill\epsfig{figure=#1,height=1.5cm}]{\epsfig{figure=#1,height=1.5cm}}
+}
+
+\newcommand{\gnusxface}[1]{
+\marginpar[\mbox{}\hfill\epsfig{figure=#1,height=1cm}]{\epsfig{figure=#1,height=1cm}}
+}
+
+
+\newcommand{\gnusitemx}[1]{\mbox{}\vspace*{-\itemsep}\vspace*{-\parsep}\item#1}
+
+\newcommand{\gnussection}[1]{
+\renewcommand{\gnussectionname}{#1}
+\section{#1}
+}
+
+\newenvironment{codelist}%
+{\begin{list}{}{
+}
+}{\end{list}}
+
+\newenvironment{kbdlist}%
+{\begin{list}{}{
+\labelwidth=0cm
+}
+}{\end{list}}
+
+\newenvironment{dfnlist}%
+{\begin{list}{}{
+}
+}{\end{list}}
+
+\newenvironment{stronglist}%
+{\begin{list}{}{
+}
+}{\end{list}}
+
+\newenvironment{samplist}%
+{\begin{list}{}{
+}
+}{\end{list}}
+
+\newenvironment{varlist}%
+{\begin{list}{}{
+}
+}{\end{list}}
+
+\newenvironment{emphlist}%
+{\begin{list}{}{
+}
+}{\end{list}}
+
+\newlength\gnusheadtextwidth
+\setlength{\gnusheadtextwidth}{\headtextwidth}
+\addtolength{\gnusheadtextwidth}{1cm}
+
+\newpagestyle{gnuspreamble}%
+{
+{
+\ifodd\count0
+{
+\hspace*{-0.23cm}\underline{\makebox[\gnusheadtextwidth]{\mbox{}}\textbf{\hfill\roman{page}}}
+}
+\else
+{
+\hspace*{-3.25cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\roman{page}\hfill\mbox{}}}
+}
+}
+\fi
+}
+}
+{
+\ifodd\count0
+\mbox{} \hfill
+\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}}
+\else
+\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}}
+\hfill \mbox{}
+\fi
+}
+
+\newpagestyle{gnusindex}%
+{
+{
+\ifodd\count0
+{
+\hspace*{-0.23cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\gnuschaptername\hfill\arabic{page}}}}
+}
+\else
+{
+\hspace*{-3.25cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{page}\hfill\gnuschaptername}}}
+}
+\fi
+}
+}
+{
+\ifodd\count0
+\mbox{} \hfill
+\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}}
+\else
+\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}}
+\hfill \mbox{}
+\fi
+}
+
+\newpagestyle{gnus}%
+{
+{
+\ifodd\count0
+{
+\makebox[12cm]{\hspace*{3.1cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{chapter}.\arabic{section}} \textbf{\gnussectionname\hfill\arabic{page}}}}}
+}
+\else
+{
+\makebox[12cm]{\hspace*{-2.95cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{page}\hfill\gnuschaptername}}}}
+}
+\fi
+}
+}
+{
+\ifodd\count0
+\mbox{} \hfill
+\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}}
+\else
+\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}}
+\hfill \mbox{}
+\fi
+}
+
+\pagenumbering{roman}
+\pagestyle{gnuspreamble}
+
+@end iflatex
+@end iftex
+
+@iftex
+@iflatex
+\begin{titlepage}
+{
+
+%\addtolength{\oddsidemargin}{-5cm}
+%\addtolength{\evensidemargin}{-5cm}
+\parindent=0cm
+\addtolength{\textheight}{2cm}
+
+\gnustitle{\gnustitlename}\\
+\rule{15cm}{1mm}\\
+\vfill
+\hspace*{0cm}\epsfig{figure=gnus-big-logo.eps,height=15cm}
+\vfill
+\rule{15cm}{1mm}\\
+\gnusauthor{by Lars Magne Ingebrigtsen}
+\newpage
+}
+
+\mbox{}
+\vfill
+
+\thispagestyle{empty}
+
+Copyright \copyright{} 1995,96 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions.
+
+\newpage
+\end{titlepage}
+@end iflatex
+@end iftex
+
+@ifinfo
+
+This file documents Gnus, the GNU Emacs newsreader.
+
+Copyright (C) 1995,96 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through Tex and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions.
+@end ifinfo
+
+@tex
+
+@titlepage
+@title Quassia Gnus 0.110 Manual
+
+@author by Lars Magne Ingebrigtsen
+@page
+
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1995,96,97 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions.
+
+@end titlepage
+@page
+
+@end tex
+
+
+@node Top
+@top The Gnus Newsreader
+
+@ifinfo
+
+You can read news (and mail) from within Emacs by using Gnus. The news
+can be gotten by any nefarious means you can think of---@sc{nntp}, local
+spool or your mbox file. All at the same time, if you want to push your
+luck.
+
+This manual corresponds to Quassia Gnus 0.110.
+
+@end ifinfo
+
+@iftex
+
+@iflatex
+\tableofcontents
+\gnuscleardoublepage
+@end iflatex
+
+Gnus is the advanced, self-documenting, customizable, extensible
+unreal-time newsreader for GNU Emacs.
+
+Oops. That sounds oddly familiar, so let's start over again to avoid
+being accused of plagiarism:
+
+Gnus is a message-reading laboratory. It will let you look at just
+about anything as if it were a newsgroup. You can read mail with it,
+you can browse directories with it, you can @code{ftp} with it---you can
+even read news with it!
+
+Gnus tries to empower people who read news the same way Emacs empowers
+people who edit text. Gnus sets no limits to what the user should be
+allowed to do. Users are encouraged to extend Gnus to make it behave
+like they want it to behave. A program should not control people;
+people should be empowered to do what they want by using (or abusing)
+the program.
+
+@end iftex
+
+
+@menu
+* Starting Up:: Finding news can be a pain.
+* The Group Buffer:: Selecting, subscribing and killing groups.
+* The Summary Buffer:: Reading, saving and posting articles.
+* The Article Buffer:: Displaying and handling articles.
+* Composing Messages:: Information on sending mail and news.
+* Select Methods:: Gnus reads all messages from various select methods.
+* Scoring:: Assigning values to articles.
+* Various:: General purpose settings.
+* The End:: Farewell and goodbye.
+* Appendices:: Terminology, Emacs intro, FAQ, History, Internals.
+* Index:: Variable, function and concept index.
+* Key Index:: Key Index.
+@end menu
+
+@node Starting Up
+@chapter Starting Gnus
+@cindex starting up
+
+@kindex M-x gnus
+@findex gnus
+If your system administrator has set things up properly, starting Gnus
+and reading news is extremely easy---you just type @kbd{M-x gnus} in
+your Emacs.
+
+@findex gnus-other-frame
+@kindex M-x gnus-other-frame
+If you want to start Gnus in a different frame, you can use the command
+@kbd{M-x gnus-other-frame} instead.
+
+If things do not go smoothly at startup, you have to twiddle some
+variables in your @file{~/.gnus} file. This file is similar to
+@file{~/.emacs}, but is read when gnus starts.
+
+@menu
+* Finding the News:: Choosing a method for getting news.
+* The First Time:: What does Gnus do the first time you start it?
+* The Server is Down:: How can I read my mail then?
+* Slave Gnusae:: You can have more than one Gnus active at a time.
+* Fetching a Group:: Starting Gnus just to read a group.
+* New Groups:: What is Gnus supposed to do with new groups?
+* Startup Files:: Those pesky startup files---@file{.newsrc}.
+* Auto Save:: Recovering from a crash.
+* The Active File:: Reading the active file over a slow line Takes Time.
+* Changing Servers:: You may want to move from one server to another.
+* Startup Variables:: Other variables you might change.
+@end menu
+
+
+@node Finding the News
+@section Finding the News
+@cindex finding news
+
+@vindex gnus-select-method
+@c @head
+The @code{gnus-select-method} variable says where Gnus should look for
+news. This variable should be a list where the first element says
+@dfn{how} and the second element says @dfn{where}. This method is your
+native method. All groups not fetched with this method are
+foreign groups.
+
+For instance, if the @samp{news.somewhere.edu} @sc{nntp} server is where
+you want to get your daily dosage of news from, you'd say:
+
+@lisp
+(setq gnus-select-method '(nntp "news.somewhere.edu"))
+@end lisp
+
+If you want to read directly from the local spool, say:
+
+@lisp
+(setq gnus-select-method '(nnspool ""))
+@end lisp
+
+If you can use a local spool, you probably should, as it will almost
+certainly be much faster.
+
+@vindex gnus-nntpserver-file
+@cindex NNTPSERVER
+@cindex @sc{nntp} server
+If this variable is not set, Gnus will take a look at the
+@code{NNTPSERVER} environment variable. If that variable isn't set,
+Gnus will see whether @code{gnus-nntpserver-file}
+(@file{/etc/nntpserver} by default) has any opinions on the matter. If
+that fails as well, Gnus will try to use the machine running Emacs as an @sc{nntp} server. That's a long shot, though.
+
+@vindex gnus-nntp-server
+If @code{gnus-nntp-server} is set, this variable will override
+@code{gnus-select-method}. You should therefore set
+@code{gnus-nntp-server} to @code{nil}, which is what it is by default.
+
+@vindex gnus-secondary-servers
+You can also make Gnus prompt you interactively for the name of an
+@sc{nntp} server. If you give a non-numerical prefix to @code{gnus}
+(i.e., @kbd{C-u M-x gnus}), Gnus will let you choose between the servers
+in the @code{gnus-secondary-servers} list (if any). You can also just
+type in the name of any server you feel like visiting.
+
+@findex gnus-group-browse-foreign-server
+@kindex B (Group)
+However, if you use one @sc{nntp} server regularly and are just
+interested in a couple of groups from a different server, you would be
+better served by using the @kbd{B} command in the group buffer. It will
+let you have a look at what groups are available, and you can subscribe
+to any of the groups you want to. This also makes @file{.newsrc}
+maintenance much tidier. @xref{Foreign Groups}.
+
+@vindex gnus-secondary-select-methods
+@c @head
+A slightly different approach to foreign groups is to set the
+@code{gnus-secondary-select-methods} variable. The select methods
+listed in this variable are in many ways just as native as the
+@code{gnus-select-method} server. They will also be queried for active
+files during startup (if that's required), and new newsgroups that
+appear on these servers will be subscribed (or not) just as native
+groups are.
+
+For instance, if you use the @code{nnmbox} backend to read your mail, you
+would typically set this variable to
+
+@lisp
+(setq gnus-secondary-select-methods '((nnmbox "")))
+@end lisp
+
+
+@node The First Time
+@section The First Time
+@cindex first time usage
+
+If no startup files exist, Gnus will try to determine what groups should
+be subscribed by default.
+
+@vindex gnus-default-subscribed-newsgroups
+If the variable @code{gnus-default-subscribed-newsgroups} is set, Gnus
+will subscribe you to just those groups in that list, leaving the rest
+killed. Your system administrator should have set this variable to
+something useful.
+
+Since she hasn't, Gnus will just subscribe you to a few arbitrarily
+picked groups (i.e., @samp{*.newusers}). (@dfn{Arbitrary} is defined
+here as @dfn{whatever Lars thinks you should read}.)
+
+You'll also be subscribed to the Gnus documentation group, which should
+help you with most common problems.
+
+If @code{gnus-default-subscribed-newsgroups} is @code{t}, Gnus will just
+use the normal functions for handling new groups, and not do anything
+special.
+
+
+@node The Server is Down
+@section The Server is Down
+@cindex server errors
+
+If the default server is down, Gnus will understandably have some
+problems starting. However, if you have some mail groups in addition to
+the news groups, you may want to start Gnus anyway.
+
+Gnus, being the trusting sort of program, will ask whether to proceed
+without a native select method if that server can't be contacted. This
+will happen whether the server doesn't actually exist (i.e., you have
+given the wrong address) or the server has just momentarily taken ill
+for some reason or other. If you decide to continue and have no foreign
+groups, you'll find it difficult to actually do anything in the group
+buffer. But, hey, that's your problem. Blllrph!
+
+@findex gnus-no-server
+@kindex M-x gnus-no-server
+@c @head
+If you know that the server is definitely down, or you just want to read
+your mail without bothering with the server at all, you can use the
+@code{gnus-no-server} command to start Gnus. That might come in handy
+if you're in a hurry as well. This command will not attempt to contact
+your primary server---instead, it will just activate all groups on level
+1 and 2. (You should preferably keep no native groups on those two
+levels.)
+
+
+@node Slave Gnusae
+@section Slave Gnusae
+@cindex slave
+
+You might want to run more than one Emacs with more than one Gnus at the
+same time. If you are using different @file{.newsrc} files (e.g., if you
+are using the two different Gnusae to read from two different servers),
+that is no problem whatsoever. You just do it.
+
+The problem appears when you want to run two Gnusae that use the same
+@code{.newsrc} file.
+
+To work around that problem some, we here at the Think-Tank at the Gnus
+Towers have come up with a new concept: @dfn{Masters} and
+@dfn{slaves}. (We have applied for a patent on this concept, and have
+taken out a copyright on those words. If you wish to use those words in
+conjunction with each other, you have to send $1 per usage instance to
+me. Usage of the patent (@dfn{Master/Slave Relationships In Computer
+Applications}) will be much more expensive, of course.)
+
+Anyways, you start one Gnus up the normal way with @kbd{M-x gnus} (or
+however you do it). Each subsequent slave Gnusae should be started with
+@kbd{M-x gnus-slave}. These slaves won't save normal @file{.newsrc}
+files, but instead save @dfn{slave files} that contain information only
+on what groups have been read in the slave session. When a master Gnus
+starts, it will read (and delete) these slave files, incorporating all
+information from them. (The slave files will be read in the sequence
+they were created, so the latest changes will have precedence.)
+
+Information from the slave files has, of course, precedence over the
+information in the normal (i.e., master) @code{.newsrc} file.
+
+
+@node Fetching a Group
+@section Fetching a Group
+@cindex fetching a group
+
+@findex gnus-fetch-group
+It is sometimes convenient to be able to just say ``I want to read this
+group and I don't care whether Gnus has been started or not''. This is
+perhaps more useful for people who write code than for users, but the
+command @code{gnus-fetch-group} provides this functionality in any case.
+It takes the group name as a parameter.
+
+
+@node New Groups
+@section New Groups
+@cindex new groups
+@cindex subscription
+
+@vindex gnus-check-new-newsgroups
+If you are satisfied that you really never want to see any new groups,
+you can set @code{gnus-check-new-newsgroups} to @code{nil}. This will
+also save you some time at startup. Even if this variable is
+@code{nil}, you can always subscribe to the new groups just by pressing
+@kbd{U} in the group buffer (@pxref{Group Maintenance}). This variable
+is @code{ask-server} by default. If you set this variable to
+@code{always}, then Gnus will query the backends for new groups even
+when you do the @kbd{g} command (@pxref{Scanning New Messages}).
+
+@menu
+* Checking New Groups:: Determining what groups are new.
+* Subscription Methods:: What Gnus should do with new groups.
+* Filtering New Groups:: Making Gnus ignore certain new groups.
+@end menu
+
+
+@node Checking New Groups
+@subsection Checking New Groups
+
+Gnus normally determines whether a group is new or not by comparing the
+list of groups from the active file(s) with the lists of subscribed and
+dead groups. This isn't a particularly fast method. If
+@code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will ask the
+server for new groups since the last time. This is both faster and
+cheaper. This also means that you can get rid of the list of killed
+groups altogether, so you may set @code{gnus-save-killed-list} to
+@code{nil}, which will save time both at startup, at exit, and all over.
+Saves disk space, too. Why isn't this the default, then?
+Unfortunately, not all servers support this command.
+
+I bet I know what you're thinking now: How do I find out whether my
+server supports @code{ask-server}? No? Good, because I don't have a
+fail-safe answer. I would suggest just setting this variable to
+@code{ask-server} and see whether any new groups appear within the next
+few days. If any do, then it works. If none do, then it doesn't
+work. I could write a function to make Gnus guess whether the server
+supports @code{ask-server}, but it would just be a guess. So I won't.
+You could @code{telnet} to the server and say @code{HELP} and see
+whether it lists @samp{NEWGROUPS} among the commands it understands. If
+it does, then it might work. (But there are servers that lists
+@samp{NEWGROUPS} without supporting the function properly.)
+
+This variable can also be a list of select methods. If so, Gnus will
+issue an @code{ask-server} command to each of the select methods, and
+subscribe them (or not) using the normal methods. This might be handy
+if you are monitoring a few servers for new groups. A side effect is
+that startup will take much longer, so you can meditate while waiting.
+Use the mantra ``dingnusdingnusdingnus'' to achieve permanent bliss.
+
+
+@node Subscription Methods
+@subsection Subscription Methods
+
+@vindex gnus-subscribe-newsgroup-method
+What Gnus does when it encounters a new group is determined by the
+@code{gnus-subscribe-newsgroup-method} variable.
+
+This variable should contain a function. This function will be called
+with the name of the new group as the only parameter.
+
+Some handy pre-fab functions are:
+
+@table @code
+
+@item gnus-subscribe-zombies
+@vindex gnus-subscribe-zombies
+Make all new groups zombies. This is the default. You can browse the
+zombies later (with @kbd{A z}) and either kill them all off properly
+(with @kbd{S z}), or subscribe to them (with @kbd{u}).
+
+@item gnus-subscribe-randomly
+@vindex gnus-subscribe-randomly
+Subscribe all new groups in arbitrary order. This really means that all
+new groups will be added at ``the top'' of the grop buffer.
+
+@item gnus-subscribe-alphabetically
+@vindex gnus-subscribe-alphabetically
+Subscribe all new groups in alphabetical order.
+
+@item gnus-subscribe-hierarchically
+@vindex gnus-subscribe-hierarchically
+Subscribe all new groups hierarchically. The difference between this
+function and @code{gnus-subscribe-alphabetically} is slight.
+@code{gnus-subscribe-alphabetically} will subscribe new groups in a strictly
+alphabetical fashion, while this function will enter groups into it's
+hierarchy. So if you want to have the @samp{rec} hierarchy before the
+@samp{comp} hierarchy, this function will not mess that configuration
+up. Or something like that.
+
+@item gnus-subscribe-interactively
+@vindex gnus-subscribe-interactively
+Subscribe new groups interactively. This means that Gnus will ask
+you about @strong{all} new groups. The groups you choose to subscribe
+to will be subscribed hierarchically.
+
+@item gnus-subscribe-killed
+@vindex gnus-subscribe-killed
+Kill all new groups.
+
+@end table
+
+@vindex gnus-subscribe-hierarchical-interactive
+A closely related variable is
+@code{gnus-subscribe-hierarchical-interactive}. (That's quite a
+mouthful.) If this variable is non-@code{nil}, Gnus will ask you in a
+hierarchical fashion whether to subscribe to new groups or not. Gnus
+will ask you for each sub-hierarchy whether you want to descend the
+hierarchy or not.
+
+One common mistake is to set the variable a few paragraphs above
+(@code{gnus-subscribe-newsgroup-method}) to
+@code{gnus-subscribe-hierarchical-interactive}. This is an error. This
+will not work. This is ga-ga. So don't do it.
+
+
+@node Filtering New Groups
+@subsection Filtering New Groups
+
+A nice and portable way to control which new newsgroups should be
+subscribed (or ignored) is to put an @dfn{options} line at the start of
+the @file{.newsrc} file. Here's an example:
+
+@example
+options -n !alt.all !rec.all sci.all
+@end example
+
+@vindex gnus-subscribe-options-newsgroup-method
+This line obviously belongs to a serious-minded intellectual scientific
+person (or she may just be plain old boring), because it says that all
+groups that have names beginning with @samp{alt} and @samp{rec} should
+be ignored, and all groups with names beginning with @samp{sci} should
+be subscribed. Gnus will not use the normal subscription method for
+subscribing these groups.
+@code{gnus-subscribe-options-newsgroup-method} is used instead. This
+variable defaults to @code{gnus-subscribe-alphabetically}.
+
+@vindex gnus-options-not-subscribe
+@vindex gnus-options-subscribe
+If you don't want to mess with your @file{.newsrc} file, you can just
+set the two variables @code{gnus-options-subscribe} and
+@code{gnus-options-not-subscribe}. These two variables do exactly the
+same as the @file{.newsrc} @samp{options -n} trick. Both are regexps,
+and if the new group matches the former, it will be unconditionally
+subscribed, and if it matches the latter, it will be ignored.
+
+@vindex gnus-auto-subscribed-groups
+Yet another variable that meddles here is
+@code{gnus-auto-subscribed-groups}. It works exactly like
+@code{gnus-options-subscribe}, and is therefore really superfluous, but I
+thought it would be nice to have two of these. This variable is more
+meant for setting some ground rules, while the other variable is used
+more for user fiddling. By default this variable makes all new groups
+that come from mail backends (@code{nnml}, @code{nnbabyl},
+@code{nnfolder}, @code{nnmbox}, and @code{nnmh}) subscribed. If you
+don't like that, just set this variable to @code{nil}.
+
+New groups that match this regexp are subscribed using
+@code{gnus-subscribe-options-newsgroup-method}.
+
+
+@node Changing Servers
+@section Changing Servers
+@cindex changing servers
+
+Sometimes it is necessary to move from one @sc{nntp} server to another.
+This happens very rarely, but perhaps you change jobs, or one server is
+very flaky and you want to use another.
+
+Changing the server is pretty easy, right? You just change
+@code{gnus-select-method} to point to the new server?
+
+@emph{Wrong!}
+
+Article numbers are not (in any way) kept synchronized between different
+@sc{nntp} servers, and the only way Gnus keeps track of what articles
+you have read is by keeping track of article numbers. So when you
+change @code{gnus-select-method}, your @file{.newsrc} file becomes
+worthless.
+
+Gnus provides a few functions to attempt to translate a @file{.newsrc}
+file from one server to another. They all have one thing in
+common---they take a looong time to run. You don't want to use these
+functions more than absolutely necessary.
+
+@kindex M-x gnus-change-server
+@findex gnus-change-server
+If you have access to both servers, Gnus can request the headers for all
+the articles you have read and compare @code{Message-ID}s and map the
+article numbers of the read articles and article marks. The @kbd{M-x
+gnus-change-server} command will do this for all your native groups. It
+will prompt for the method you want to move to.
+
+@kindex M-x gnus-group-move-group-to-server
+@findex gnus-group-move-group-to-server
+You can also move individual groups with the @kbd{M-x
+gnus-group-move-group-to-server} command. This is useful if you want to
+move a (foreign) group from one server to another.
+
+@kindex M-x gnus-group-clear-data-on-native-groups
+@findex gnus-group-clear-data-on-native-groups
+If you don't have access to both the old and new server, all your marks
+and read ranges have become worthless. You can use the @kbd{M-x
+gnus-group-clear-data-on-native-groups} command to clear out all data
+that you have on your native groups. Use with caution.
+
+
+@node Startup Files
+@section Startup Files
+@cindex startup files
+@cindex .newsrc
+@cindex .newsrc.el
+@cindex .newsrc.eld
+
+Now, you all know about the @file{.newsrc} file. All subscription
+information is traditionally stored in this file.
+
+Things got a bit more complicated with @sc{gnus}. In addition to
+keeping the @file{.newsrc} file updated, it also used a file called
+@file{.newsrc.el} for storing all the information that didn't fit into
+the @file{.newsrc} file. (Actually, it also duplicated everything in
+the @file{.newsrc} file.) @sc{gnus} would read whichever one of these
+files was the most recently saved, which enabled people to swap between
+@sc{gnus} and other newsreaders.
+
+That was kinda silly, so Gnus went one better: In addition to the
+@file{.newsrc} and @file{.newsrc.el} files, Gnus also has a file called
+@file{.newsrc.eld}. It will read whichever of these files that are most
+recent, but it will never write a @file{.newsrc.el} file.
+
+@vindex gnus-save-newsrc-file
+You can turn off writing the @file{.newsrc} file by setting
+@code{gnus-save-newsrc-file} to @code{nil}, which means you can delete
+the file and save some space, as well as making exit from Gnus faster.
+However, this will make it impossible to use other newsreaders than
+Gnus. But hey, who would want to, right?
+
+@vindex gnus-save-killed-list
+If @code{gnus-save-killed-list} (default @code{t}) is @code{nil}, Gnus
+will not save the list of killed groups to the startup file. This will
+save both time (when starting and quitting) and space (on disk). It
+will also mean that Gnus has no record of what groups are new or old,
+so the automatic new groups subscription methods become meaningless.
+You should always set @code{gnus-check-new-newsgroups} to @code{nil} or
+@code{ask-server} if you set this variable to @code{nil} (@pxref{New
+Groups}). This variable can also be a regular expression. If that's
+the case, remove all groups that do not match this regexp before
+saving. This can be useful in certain obscure situations that involve
+several servers where not all servers support @code{ask-server}.
+
+@vindex gnus-startup-file
+The @code{gnus-startup-file} variable says where the startup files are.
+The default value is @file{~/.newsrc}, with the Gnus (El Dingo) startup
+file being whatever that one is, with a @samp{.eld} appended.
+
+@vindex gnus-save-newsrc-hook
+@vindex gnus-save-quick-newsrc-hook
+@vindex gnus-save-standard-newsrc-hook
+@code{gnus-save-newsrc-hook} is called before saving any of the newsrc
+files, while @code{gnus-save-quick-newsrc-hook} is called just before
+saving the @file{.newsrc.eld} file, and
+@code{gnus-save-standard-newsrc-hook} is called just before saving the
+@file{.newsrc} file. The latter two are commonly used to turn version
+control on or off. Version control is on by default when saving the
+startup files. If you want to turn backup creation off, say something like:
+
+@lisp
+(defun turn-off-backup ()
+ (set (make-local-variable 'backup-inhibited) t))
+
+(add-hook 'gnus-save-quick-newsrc-hook 'turn-off-backup)
+(add-hook 'gnus-save-standard-newsrc-hook 'turn-off-backup)
+@end lisp
+
+@vindex gnus-init-file
+When Gnus starts, it will read the @code{gnus-site-init-file}
+(@file{.../site-lisp/gnus} by default) and @code{gnus-init-file}
+(@file{~/.gnus} by default) files. These are normal Emacs Lisp files
+and can be used to avoid cluttering your @file{~/.emacs} and
+@file{site-init} files with Gnus stuff. Gnus will also check for files
+with the same names as these, but with @file{.elc} and @file{.el}
+suffixes. In other words, if you have set @code{gnus-init-file} to
+@file{~/.gnus}, it will look for @file{~/.gnus.elc}, @file{~/.gnus.el},
+and finally @file{~/.gnus} (in this order).
+
+
+
+@node Auto Save
+@section Auto Save
+@cindex dribble file
+@cindex auto-save
+
+Whenever you do something that changes the Gnus data (reading articles,
+catching up, killing/subscribing groups), the change is added to a
+special @dfn{dribble buffer}. This buffer is auto-saved the normal
+Emacs way. If your Emacs should crash before you have saved the
+@file{.newsrc} files, all changes you have made can be recovered from
+this file.
+
+If Gnus detects this file at startup, it will ask the user whether to
+read it. The auto save file is deleted whenever the real startup file is
+saved.
+
+@vindex gnus-use-dribble-file
+If @code{gnus-use-dribble-file} is @code{nil}, Gnus won't create and
+maintain a dribble buffer. The default is @code{t}.
+
+@vindex gnus-dribble-directory
+Gnus will put the dribble file(s) in @code{gnus-dribble-directory}. If
+this variable is @code{nil}, which it is by default, Gnus will dribble
+into the directory where the @file{.newsrc} file is located. (This is
+normally the user's home directory.) The dribble file will get the same
+file permissions as the @code{.newsrc} file.
+
+
+@node The Active File
+@section The Active File
+@cindex active file
+@cindex ignored groups
+
+When Gnus starts, or indeed whenever it tries to determine whether new
+articles have arrived, it reads the active file. This is a very large
+file that lists all the active groups and articles on the server.
+
+@vindex gnus-ignored-newsgroups
+Before examining the active file, Gnus deletes all lines that match the
+regexp @code{gnus-ignored-newsgroups}. This is done primarily to reject
+any groups with bogus names, but you can use this variable to make Gnus
+ignore hierarchies you aren't ever interested in. However, this is not
+recommended. In fact, it's highly discouraged. Instead, @pxref{New
+Groups} for an overview of other variables that can be used instead.
+
+@c This variable is
+@c @code{nil} by default, and will slow down active file handling somewhat
+@c if you set it to anything else.
+
+@vindex gnus-read-active-file
+@c @head
+The active file can be rather Huge, so if you have a slow network, you
+can set @code{gnus-read-active-file} to @code{nil} to prevent Gnus from
+reading the active file. This variable is @code{some} by default.
+
+Gnus will try to make do by getting information just on the groups that
+you actually subscribe to.
+
+Note that if you subscribe to lots and lots of groups, setting this
+variable to @code{nil} will probably make Gnus slower, not faster. At
+present, having this variable @code{nil} will slow Gnus down
+considerably, unless you read news over a 2400 baud modem.
+
+This variable can also have the value @code{some}. Gnus will then
+attempt to read active info only on the subscribed groups. On some
+servers this is quite fast (on sparkling, brand new INN servers that
+support the @code{LIST ACTIVE group} command), on others this isn't fast
+at all. In any case, @code{some} should be faster than @code{nil}, and
+is certainly faster than @code{t} over slow lines.
+
+If this variable is @code{nil}, Gnus will ask for group info in total
+lock-step, which isn't very fast. If it is @code{some} and you use an
+@sc{nntp} server, Gnus will pump out commands as fast as it can, and
+read all the replies in one swoop. This will normally result in better
+performance, but if the server does not support the aforementioned
+@code{LIST ACTIVE group} command, this isn't very nice to the server.
+
+In any case, if you use @code{some} or @code{nil}, you should definitely
+kill all groups that you aren't interested in to speed things up.
+
+Note that this variable also affects active file retrieval from
+secondary select methods.
+
+
+@node Startup Variables
+@section Startup Variables
+
+@table @code
+
+@item gnus-load-hook
+@vindex gnus-load-hook
+A hook run while Gnus is being loaded. Note that this hook will
+normally be run just once in each Emacs session, no matter how many
+times you start Gnus.
+
+@item gnus-before-startup-hook
+@vindex gnus-before-startup-hook
+A hook run after starting up Gnus successfully.
+
+@item gnus-startup-hook
+@vindex gnus-startup-hook
+A hook run as the very last thing after starting up Gnus
+
+@item gnus-started-hook
+@vindex gnus-started-hook
+A hook that is run as the very last thing after starting up Gnus
+successfully.
+
+@item gnus-started-hook
+@vindex gnus-started-hook
+A hook that is run after reading the @file{.newsrc} file(s), but before
+generating the group buffer.
+
+@item gnus-check-bogus-newsgroups
+@vindex gnus-check-bogus-newsgroups
+If non-@code{nil}, Gnus will check for and delete all bogus groups at
+startup. A @dfn{bogus group} is a group that you have in your
+@file{.newsrc} file, but doesn't exist on the news server. Checking for
+bogus groups can take quite a while, so to save time and resources it's
+best to leave this option off, and do the checking for bogus groups once
+in a while from the group buffer instead (@pxref{Group Maintenance}).
+
+@item gnus-inhibit-startup-message
+@vindex gnus-inhibit-startup-message
+If non-@code{nil}, the startup message won't be displayed. That way,
+your boss might not notice as easily that you are reading news instead
+of doing your job. Note that this variable is used before
+@file{.gnus.el} is loaded, so it should be set in @code{.emacs} instead.
+
+@item gnus-no-groups-message
+@vindex gnus-no-groups-message
+Message displayed by Gnus when no groups are available.
+
+@item gnus-play-startup-jingle
+@vindex gnus-play-startup-jingle
+If non-@code{nil}, play the Gnus jingle at startup.
+
+@item gnus-startup-jingle
+@vindex gnus-startup-jingle
+Jingle to be played if the above variable is non-@code{nil}. The
+default is @samp{Tuxedomoon.Jingle4.au}.
+
+@end table
+
+
+@node The Group Buffer
+@chapter The Group Buffer
+@cindex group buffer
+
+The @dfn{group buffer} lists all (or parts) of the available groups. It
+is the first buffer shown when Gnus starts, and will never be killed as
+long as Gnus is active.
+
+@iftex
+@iflatex
+\gnusfigure{The Group Buffer}{320}{
+\put(75,50){\epsfig{figure=tmp/group.ps,height=9cm}}
+\put(120,37){\makebox(0,0)[t]{Buffer name}}
+\put(120,38){\vector(1,2){10}}
+\put(40,60){\makebox(0,0)[r]{Mode line}}
+\put(40,58){\vector(1,0){30}}
+\put(200,28){\makebox(0,0)[t]{Native select method}}
+\put(200,26){\vector(-1,2){15}}
+}
+@end iflatex
+@end iftex
+
+@menu
+* Group Buffer Format:: Information listed and how you can change it.
+* Group Maneuvering:: Commands for moving in the group buffer.
+* Selecting a Group:: Actually reading news.
+* Group Data:: Changing the info for a group.
+* Subscription Commands:: Unsubscribing, killing, subscribing.
+* Group Levels:: Levels? What are those, then?
+* Group Score:: A mechanism for finding out what groups you like.
+* Marking Groups:: You can mark groups for later processing.
+* Foreign Groups:: Creating and editing groups.
+* Group Parameters:: Each group may have different parameters set.
+* Listing Groups:: Gnus can list various subsets of the groups.
+* Sorting Groups:: Re-arrange the group order.
+* Group Maintenance:: Maintaining a tidy @file{.newsrc} file.
+* Browse Foreign Server:: You can browse a server. See what it has to offer.
+* Exiting Gnus:: Stop reading news and get some work done.
+* Group Topics:: A folding group mode divided into topics.
+* Misc Group Stuff:: Other stuff that you can to do.
+@end menu
+
+
+@node Group Buffer Format
+@section Group Buffer Format
+
+@menu
+* Group Line Specification:: Deciding how the group buffer is to look.
+* Group Modeline Specification:: The group buffer modeline.
+* Group Highlighting:: Having nice colors in the group buffer.
+@end menu
+
+
+@node Group Line Specification
+@subsection Group Line Specification
+@cindex group buffer format
+
+The default format of the group buffer is nice and dull, but you can
+make it as exciting and ugly as you feel like.
+
+Here's a couple of example group lines:
+
+@example
+ 25: news.announce.newusers
+ * 0: alt.fan.andrea-dworkin
+@end example
+
+Quite simple, huh?
+
+You can see that there are 25 unread articles in
+@samp{news.announce.newusers}. There are no unread articles, but some
+ticked articles, in @samp{alt.fan.andrea-dworkin} (see that little
+asterisk at the beginning of the line?).
+
+@vindex gnus-group-line-format
+You can change that format to whatever you want by fiddling with the
+@code{gnus-group-line-format} variable. This variable works along the
+lines of a @code{format} specification, which is pretty much the same as
+a @code{printf} specifications, for those of you who use (feh!) C.
+@xref{Formatting Variables}.
+
+@samp{%M%S%5y: %(%g%)\n} is the value that produced those lines above.
+
+There should always be a colon on the line; the cursor always moves to
+the colon after performing an operation. Nothing else is required---not
+even the group name. All displayed text is just window dressing, and is
+never examined by Gnus. Gnus stores all real information it needs using
+text properties.
+
+(Note that if you make a really strange, wonderful, spreadsheet-like
+layout, everybody will believe you are hard at work with the accounting
+instead of wasting time reading news.)
+
+Here's a list of all available format characters:
+
+@table @samp
+
+@item M
+An asterisk if the group only has marked articles.
+
+@item S
+Whether the group is subscribed.
+
+@item L
+Level of subscribedness.
+
+@item N
+Number of unread articles.
+
+@item I
+Number of dormant articles.
+
+@item T
+Number of ticked articles.
+
+@item R
+Number of read articles.
+
+@item t
+Estimated total number of articles. (This is really @var{max-number}
+minus @var{min-number} plus 1.)
+
+@item y
+Number of unread, unticked, non-dormant articles.
+
+@item i
+Number of ticked and dormant articles.
+
+@item g
+Full group name.
+
+@item G
+Group name.
+
+@item D
+Newsgroup description.
+
+@item o
+@samp{m} if moderated.
+
+@item O
+@samp{(m)} if moderated.
+
+@item s
+Select method.
+
+@item n
+Select from where.
+
+@item z
+A string that looks like @samp{<%s:%n>} if a foreign select method is
+used.
+
+@item P
+Indentation based on the level of the topic (@pxref{Group Topics}).
+
+@item c
+@vindex gnus-group-uncollapsed-levels
+Short (collapsed) group name. The @code{gnus-group-uncollapsed-levels}
+variable says how many levels to leave at the end of the group name.
+The default is 1---this will mean that group names like
+@samp{gnu.emacs.gnus} will be shortened to @samp{g.emacs.gnus}.
+
+@item m
+@vindex gnus-new-mail-mark
+@cindex %
+@samp{%} (@code{gnus-new-mail-mark}) if there has arrived new mail to
+the group lately.
+
+@item d
+A string that says when you last read the group (@pxref{Group
+Timestamp}).
+
+@item u
+User defined specifier. The next character in the format string should
+be a letter. Gnus will call the function
+@code{gnus-user-format-function-}@samp{X}, where @samp{X} is the letter
+following @samp{%u}. The function will be passed a single dummy
+parameter as argument. The function should return a string, which will
+be inserted into the buffer just like information from any other
+specifier.
+@end table
+
+@cindex *
+All the ``number-of'' specs will be filled with an asterisk (@samp{*})
+if no info is available---for instance, if it is a non-activated foreign
+group, or a bogus native group.
+
+
+@node Group Modeline Specification
+@subsection Group Modeline Specification
+@cindex group modeline
+
+@vindex gnus-group-mode-line-format
+The mode line can be changed by setting
+@code{gnus-group-mode-line-format} (@pxref{Formatting Variables}). It
+doesn't understand that many format specifiers:
+
+@table @samp
+@item S
+The native news server.
+@item M
+The native select method.
+@end table
+
+
+@node Group Highlighting
+@subsection Group Highlighting
+@cindex highlighting
+@cindex group highlighting
+
+@vindex gnus-group-highlight
+Highlighting in the group buffer is controlled by the
+@code{gnus-group-highlight} variable. This is an alist with elements
+that look like @var{(form . face)}. If @var{form} evaluates to
+something non-@code{nil}, the @var{face} will be used on the line.
+
+Here's an example value for this variable that might look nice if the
+background is dark:
+
+@lisp
+(setq gnus-group-highlight
+ `(((> unread 200) .
+ ,(custom-face-lookup "Red" nil nil t nil nil))
+ ((and (< level 3) (zerop unread)) .
+ ,(custom-face-lookup "SeaGreen" nil nil t nil nil))
+ ((< level 3) .
+ ,(custom-face-lookup "SpringGreen" nil nil t nil nil))
+ ((zerop unread) .
+ ,(custom-face-lookup "SteelBlue" nil nil t nil nil))
+ (t .
+ ,(custom-face-lookup "SkyBlue" nil nil t nil nil))))
+@end lisp
+
+Variables that are dynamically bound when the forms are evaluated
+include:
+
+@table @code
+@item group
+The group name.
+@item unread
+The number of unread articles in the group.
+@item method
+The select method.
+@item mailp
+Whether the group is a mail group.
+@item level
+The level of the group.
+@item score
+The score of the group.
+@item ticked
+The number of ticked articles in the group.
+@item total
+The total number of articles in the group. Or rather, MAX-NUMBER minus
+MIN-NUMBER plus one.
+@item topic
+When using the topic minor mode, this variable is bound to the current
+topic being inserted.
+@end table
+
+When the forms are @code{eval}ed, point is at the beginning of the line
+of the group in question, so you can use many of the normal Gnus
+functions for snarfing info on the group.
+
+@vindex gnus-group-update-hook
+@findex gnus-group-highlight-line
+@code{gnus-group-update-hook} is called when a group line is changed.
+It will not be called when @code{gnus-visual} is @code{nil}. This hook
+calls @code{gnus-group-highlight-line} by default.
+
+
+@node Group Maneuvering
+@section Group Maneuvering
+@cindex group movement
+
+All movement commands understand the numeric prefix and will behave as
+expected, hopefully.
+
+@table @kbd
+
+@item n
+@kindex n (Group)
+@findex gnus-group-next-unread-group
+Go to the next group that has unread articles
+(@code{gnus-group-next-unread-group}).
+
+@item p
+@itemx DEL
+@kindex DEL (Group)
+@kindex p (Group)
+@findex gnus-group-prev-unread-group
+Go to the previous group that has unread articles
+(@code{gnus-group-prev-unread-group}).
+
+@item N
+@kindex N (Group)
+@findex gnus-group-next-group
+Go to the next group (@code{gnus-group-next-group}).
+
+@item P
+@kindex P (Group)
+@findex gnus-group-prev-group
+Go to the previous group (@code{gnus-group-prev-group}).
+
+@item M-p
+@kindex M-p (Group)
+@findex gnus-group-next-unread-group-same-level
+Go to the next unread group on the same (or lower) level
+(@code{gnus-group-next-unread-group-same-level}).
+
+@item M-n
+@kindex M-n (Group)
+@findex gnus-group-prev-unread-group-same-level
+Go to the previous unread group on the same (or lower) level
+(@code{gnus-group-prev-unread-group-same-level}).
+@end table
+
+Three commands for jumping to groups:
+
+@table @kbd
+
+@item j
+@kindex j (Group)
+@findex gnus-group-jump-to-group
+Jump to a group (and make it visible if it isn't already)
+(@code{gnus-group-jump-to-group}). Killed groups can be jumped to, just
+like living groups.
+
+@item ,
+@kindex , (Group)
+@findex gnus-group-best-unread-group
+Jump to the unread group with the lowest level
+(@code{gnus-group-best-unread-group}).
+
+@item .
+@kindex . (Group)
+@findex gnus-group-first-unread-group
+Jump to the first group with unread articles
+(@code{gnus-group-first-unread-group}).
+@end table
+
+@vindex gnus-group-goto-unread
+If @code{gnus-group-goto-unread} is @code{nil}, all the movement
+commands will move to the next group, not the next unread group. Even
+the commands that say they move to the next unread group. The default
+is @code{t}.
+
+
+@node Selecting a Group
+@section Selecting a Group
+@cindex group selection
+
+@table @kbd
+
+@item SPACE
+@kindex SPACE (Group)
+@findex gnus-group-read-group
+Select the current group, switch to the summary buffer and display the
+first unread article (@code{gnus-group-read-group}). If there are no
+unread articles in the group, or if you give a non-numerical prefix to
+this command, Gnus will offer to fetch all the old articles in this
+group from the server. If you give a numerical prefix @var{N}, @var{N}
+determines the number of articles Gnus will fetch. If @var{N} is
+positive, Gnus fetches the @var{N} newest articles, if @var{N} is
+negative, Gnus fetches the @var{abs(N)} oldest articles.
+
+@item RET
+@kindex RET (Group)
+@findex gnus-group-select-group
+Select the current group and switch to the summary buffer
+(@code{gnus-group-select-group}). Takes the same arguments as
+@code{gnus-group-read-group}---the only difference is that this command
+does not display the first unread article automatically upon group
+entry.
+
+@item M-RET
+@kindex M-RET (Group)
+@findex gnus-group-quick-select-group
+This does the same as the command above, but tries to do it with the
+minimum amount of fuzz (@code{gnus-group-quick-select-group}). No
+scoring/killing will be performed, there will be no highlights and no
+expunging. This might be useful if you're in a real hurry and have to
+enter some humongous group. If you give a 0 prefix to this command
+(i.e., @kbd{0 M-RET}), Gnus won't even generate the summary buffer,
+which is useful if you want to toggle threading before generating the
+summary buffer (@pxref{Summary Generation Commands}).
+
+@item M-SPACE
+@kindex M-SPACE (Group)
+@findex gnus-group-visible-select-group
+This is yet one more command that does the same as the @kbd{RET}
+command, but this one does it without expunging and hiding dormants
+(@code{gnus-group-visible-select-group}).
+
+@item M-C-RET
+@kindex M-C-RET (Group)
+@findex gnus-group-select-group-ephemerally
+Finally, this command selects the current group ephemerally without
+doing any processing of its contents
+(@code{gnus-group-select-group-ephemerally}). Even threading has been
+turned off. Everything you do in the group after selecting it in this
+manner will have no permanent effects.
+
+@end table
+
+@vindex gnus-large-newsgroup
+The @code{gnus-large-newsgroup} variable says what Gnus should consider
+to be a big group. This is 200 by default. If the group has more
+(unread and/or ticked) articles than this, Gnus will query the user
+before entering the group. The user can then specify how many articles
+should be fetched from the server. If the user specifies a negative
+number (@code{-n}), the @code{n} oldest articles will be fetched. If it
+is positive, the @code{n} articles that have arrived most recently will
+be fetched.
+
+@vindex gnus-select-group-hook
+@vindex gnus-auto-select-first
+@code{gnus-auto-select-first} control whether any articles are selected
+automatically when entering a group with the @kbd{SPACE} command.
+
+@table @code
+
+@item nil
+Don't select any articles when entering the group. Just display the
+full summary buffer.
+
+@item t
+Select the first unread article when entering the group.
+
+@item best
+Select the most high-scored article in the group when entering the
+group.
+@end table
+
+If you want to prevent automatic selection in some group (say, in a
+binary group with Huge articles) you can set this variable to @code{nil}
+in @code{gnus-select-group-hook}, which is called when a group is
+selected.
+
+
+@node Subscription Commands
+@section Subscription Commands
+@cindex subscription
+
+@table @kbd
+
+@item S t
+@itemx u
+@kindex S t (Group)
+@kindex u (Group)
+@findex gnus-group-unsubscribe-current-group
+@c @icon{gnus-group-unsubscribe}
+Toggle subscription to the current group
+(@code{gnus-group-unsubscribe-current-group}).
+
+@item S s
+@itemx U
+@kindex S s (Group)
+@kindex U (Group)
+@findex gnus-group-unsubscribe-group
+Prompt for a group to subscribe, and then subscribe it. If it was
+subscribed already, unsubscribe it instead
+(@code{gnus-group-unsubscribe-group}).
+
+@item S k
+@itemx C-k
+@kindex S k (Group)
+@kindex C-k (Group)
+@findex gnus-group-kill-group
+@c @icon{gnus-group-kill-group}
+Kill the current group (@code{gnus-group-kill-group}).
+
+@item S y
+@itemx C-y
+@kindex S y (Group)
+@kindex C-y (Group)
+@findex gnus-group-yank-group
+Yank the last killed group (@code{gnus-group-yank-group}).
+
+@item C-x C-t
+@kindex C-x C-t (Group)
+@findex gnus-group-transpose-groups
+Transpose two groups (@code{gnus-group-transpose-groups}). This isn't
+really a subscription command, but you can use it instead of a
+kill-and-yank sequence sometimes.
+
+@item S w
+@itemx C-w
+@kindex S w (Group)
+@kindex C-w (Group)
+@findex gnus-group-kill-region
+Kill all groups in the region (@code{gnus-group-kill-region}).
+
+@item S z
+@kindex S z (Group)
+@findex gnus-group-kill-all-zombies
+Kill all zombie groups (@code{gnus-group-kill-all-zombies}).
+
+@item S C-k
+@kindex S C-k (Group)
+@findex gnus-group-kill-level
+Kill all groups on a certain level (@code{gnus-group-kill-level}).
+These groups can't be yanked back after killing, so this command should
+be used with some caution. The only time where this command comes in
+really handy is when you have a @file{.newsrc} with lots of unsubscribed
+groups that you want to get rid off. @kbd{S C-k} on level 7 will
+kill off all unsubscribed groups that do not have message numbers in the
+@file{.newsrc} file.
+
+@end table
+
+Also @pxref{Group Levels}.
+
+
+@node Group Data
+@section Group Data
+
+@table @kbd
+
+@item c
+@kindex c (Group)
+@findex gnus-group-catchup-current
+@vindex gnus-group-catchup-group-hook
+@c @icon{gnus-group-catchup-current}
+Mark all unticked articles in this group as read
+(@code{gnus-group-catchup-current}).
+@code{gnus-group-catchup-group-hook} is called when catching up a group from
+the group buffer.
+
+@item C
+@kindex C (Group)
+@findex gnus-group-catchup-current-all
+Mark all articles in this group, even the ticked ones, as read
+(@code{gnus-group-catchup-current-all}).
+
+@item M-c
+@kindex M-c (Group)
+@findex gnus-group-clear-data
+Clear the data from the current group---nix out marks and the list of
+read articles (@code{gnus-group-clear-data}).
+
+@item M-x gnus-group-clear-data-on-native-groups
+@kindex M-x gnus-group-clear-data-on-native-groups
+@findex gnus-group-clear-data-on-native-groups
+If you have switched from one @sc{nntp} server to another, all your marks
+and read ranges have become worthless. You can use this command to
+clear out all data that you have on your native groups. Use with
+caution.
+
+@end table
+
+
+@node Group Levels
+@section Group Levels
+@cindex group level
+@cindex level
+
+All groups have a level of @dfn{subscribedness}. For instance, if a
+group is on level 2, it is more subscribed than a group on level 5. You
+can ask Gnus to just list groups on a given level or lower
+(@pxref{Listing Groups}), or to just check for new articles in groups on
+a given level or lower (@pxref{Scanning New Messages}).
+
+Remember: The higher the level of the group, the less important it is.
+
+@table @kbd
+
+@item S l
+@kindex S l (Group)
+@findex gnus-group-set-current-level
+Set the level of the current group. If a numeric prefix is given, the
+next @var{n} groups will have their levels set. The user will be
+prompted for a level.
+@end table
+
+@vindex gnus-level-killed
+@vindex gnus-level-zombie
+@vindex gnus-level-unsubscribed
+@vindex gnus-level-subscribed
+Gnus considers groups from levels 1 to
+@code{gnus-level-subscribed} (inclusive) (default 5) to be subscribed,
+@code{gnus-level-subscribed} (exclusive) and
+@code{gnus-level-unsubscribed} (inclusive) (default 7) to be
+unsubscribed, @code{gnus-level-zombie} to be zombies (walking dead)
+(default 8) and @code{gnus-level-killed} to be killed (completely dead)
+(default 9). Gnus treats subscribed and unsubscribed groups exactly the
+same, but zombie and killed groups have no information on what articles
+you have read, etc, stored. This distinction between dead and living
+groups isn't done because it is nice or clever, it is done purely for
+reasons of efficiency.
+
+It is recommended that you keep all your mail groups (if any) on quite
+low levels (e.g. 1 or 2).
+
+If you want to play with the level variables, you should show some care.
+Set them once, and don't touch them ever again. Better yet, don't touch
+them at all unless you know exactly what you're doing.
+
+@vindex gnus-level-default-unsubscribed
+@vindex gnus-level-default-subscribed
+Two closely related variables are @code{gnus-level-default-subscribed}
+(default 3) and @code{gnus-level-default-unsubscribed} (default 6),
+which are the levels that new groups will be put on if they are
+(un)subscribed. These two variables should, of course, be inside the
+relevant valid ranges.
+
+@vindex gnus-keep-same-level
+If @code{gnus-keep-same-level} is non-@code{nil}, some movement commands
+will only move to groups of the same level (or lower). In
+particular, going from the last article in one group to the next group
+will go to the next group of the same level (or lower). This might be
+handy if you want to read the most important groups before you read the
+rest.
+
+@vindex gnus-group-default-list-level
+All groups with a level less than or equal to
+@code{gnus-group-default-list-level} will be listed in the group buffer
+by default.
+
+@vindex gnus-group-list-inactive-groups
+If @code{gnus-group-list-inactive-groups} is non-@code{nil}, non-active
+groups will be listed along with the unread groups. This variable is
+@code{t} by default. If it is @code{nil}, inactive groups won't be
+listed.
+
+@vindex gnus-group-use-permanent-levels
+If @code{gnus-group-use-permanent-levels} is non-@code{nil}, once you
+give a level prefix to @kbd{g} or @kbd{l}, all subsequent commands will
+use this level as the ``work'' level.
+
+@vindex gnus-activate-level
+Gnus will normally just activate (i. e., query the server about) groups
+on level @code{gnus-activate-level} or less. If you don't want to
+activate unsubscribed groups, for instance, you might set this variable
+to 5. The default is 6.
+
+
+@node Group Score
+@section Group Score
+@cindex group score
+
+You would normally keep important groups on high levels, but that scheme
+is somewhat restrictive. Don't you wish you could have Gnus sort the
+group buffer according to how often you read groups, perhaps? Within
+reason?
+
+This is what @dfn{group score} is for. You can assign a score to each
+group. You can then sort the group buffer based on this score.
+Alternatively, you can sort on score and then level. (Taken together,
+the level and the score is called the @dfn{rank} of the group. A group
+that is on level 4 and has a score of 1 has a higher rank than a group
+on level 5 that has a score of 300. (The level is the most significant
+part and the score is the least significant part.))
+
+@findex gnus-summary-bubble-group
+If you want groups you read often to get higher scores than groups you
+read seldom you can add the @code{gnus-summary-bubble-group} function to
+the @code{gnus-summary-exit-hook} hook. This will result (after
+sorting) in a bubbling sort of action. If you want to see that in
+action after each summary exit, you can add
+@code{gnus-group-sort-groups-by-rank} or
+@code{gnus-group-sort-groups-by-score} to the same hook, but that will
+slow things down somewhat.
+
+
+@node Marking Groups
+@section Marking Groups
+@cindex marking groups
+
+If you want to perform some command on several groups, and they appear
+subsequently in the group buffer, you would normally just give a
+numerical prefix to the command. Most group commands will then do your
+bidding on those groups.
+
+However, if the groups are not in sequential order, you can still
+perform a command on several groups. You simply mark the groups first
+with the process mark and then execute the command.
+
+@table @kbd
+
+@item #
+@kindex # (Group)
+@itemx M m
+@kindex M m (Group)
+@findex gnus-group-mark-group
+Set the mark on the current group (@code{gnus-group-mark-group}).
+
+@item M-#
+@kindex M-# (Group)
+@itemx M u
+@kindex M u (Group)
+@findex gnus-group-unmark-group
+Remove the mark from the current group
+(@code{gnus-group-unmark-group}).
+
+@item M U
+@kindex M U (Group)
+@findex gnus-group-unmark-all-groups
+Remove the mark from all groups (@code{gnus-group-unmark-all-groups}).
+
+@item M w
+@kindex M w (Group)
+@findex gnus-group-mark-region
+Mark all groups between point and mark (@code{gnus-group-mark-region}).
+
+@item M b
+@kindex M b (Group)
+@findex gnus-group-mark-buffer
+Mark all groups in the buffer (@code{gnus-group-mark-buffer}).
+
+@item M r
+@kindex M r (Group)
+@findex gnus-group-mark-regexp
+Mark all groups that match some regular expression
+(@code{gnus-group-mark-regexp}).
+@end table
+
+Also @pxref{Process/Prefix}.
+
+@findex gnus-group-universal-argument
+If you want to execute some command on all groups that have been marked
+with the process mark, you can use the @kbd{M-&}
+(@code{gnus-group-universal-argument}) command. It will prompt you for
+the command to be executed.
+
+
+@node Foreign Groups
+@section Foreign Groups
+@cindex foreign groups
+
+Below are some group mode commands for making and editing general foreign
+groups, as well as commands to ease the creation of a few
+special-purpose groups. All these commands insert the newly created
+groups under point---@code{gnus-subscribe-newsgroup-method} is not
+consulted.
+
+@table @kbd
+
+@item G m
+@kindex G m (Group)
+@findex gnus-group-make-group
+@cindex making groups
+Make a new group (@code{gnus-group-make-group}). Gnus will prompt you
+for a name, a method and possibly an @dfn{address}. For an easier way
+to subscribe to @sc{nntp} groups, @pxref{Browse Foreign Server}.
+
+@item G r
+@kindex G r (Group)
+@findex gnus-group-rename-group
+@cindex renaming groups
+Rename the current group to something else
+(@code{gnus-group-rename-group}). This is valid only on some
+groups---mail groups mostly. This command might very well be quite slow
+on some backends.
+
+@item G c
+@kindex G c (Group)
+@cindex customizing
+@findex gnus-group-customize
+Customize the group parameters (@code{gnus-group-customize}).
+
+@item G e
+@kindex G e (Group)
+@findex gnus-group-edit-group-method
+@cindex renaming groups
+Enter a buffer where you can edit the select method of the current
+group (@code{gnus-group-edit-group-method}).
+
+@item G p
+@kindex G p (Group)
+@findex gnus-group-edit-group-parameters
+Enter a buffer where you can edit the group parameters
+(@code{gnus-group-edit-group-parameters}).
+
+@item G E
+@kindex G E (Group)
+@findex gnus-group-edit-group
+Enter a buffer where you can edit the group info
+(@code{gnus-group-edit-group}).
+
+@item G d
+@kindex G d (Group)
+@findex gnus-group-make-directory-group
+@cindex nndir
+Make a directory group (@pxref{Directory Groups}). You will be prompted
+for a directory name (@code{gnus-group-make-directory-group}).
+
+@item G h
+@kindex G h (Group)
+@cindex help group
+@findex gnus-group-make-help-group
+Make the Gnus help group (@code{gnus-group-make-help-group}).
+
+@item G a
+@kindex G a (Group)
+@cindex (ding) archive
+@cindex archive group
+@findex gnus-group-make-archive-group
+@vindex gnus-group-archive-directory
+@vindex gnus-group-recent-archive-directory
+Make a Gnus archive group (@code{gnus-group-make-archive-group}). By
+default a group pointing to the most recent articles will be created
+(@code{gnus-group-recent-archive-directory}), but given a prefix, a full
+group will be created from @code{gnus-group-archive-directory}.
+
+@item G k
+@kindex G k (Group)
+@findex gnus-group-make-kiboze-group
+@cindex nnkiboze
+Make a kiboze group. You will be prompted for a name, for a regexp to
+match groups to be ``included'' in the kiboze group, and a series of
+strings to match on headers (@code{gnus-group-make-kiboze-group}).
+@xref{Kibozed Groups}.
+
+@item G D
+@kindex G D (Group)
+@findex gnus-group-enter-directory
+@cindex nneething
+Read an arbitrary directory as if it were a newsgroup with the
+@code{nneething} backend (@code{gnus-group-enter-directory}).
+@xref{Anything Groups}.
+
+@item G f
+@kindex G f (Group)
+@findex gnus-group-make-doc-group
+@cindex ClariNet Briefs
+@cindex nndoc
+Make a group based on some file or other
+(@code{gnus-group-make-doc-group}). If you give a prefix to this
+command, you will be prompted for a file name and a file type.
+Currently supported types are @code{babyl}, @code{mbox}, @code{digest},
+@code{mmdf}, @code{news}, @code{rnews}, @code{clari-briefs},
+@code{rfc934}, @code{rfc822-forward}, and @code{forward}. If you run
+this command without a prefix, Gnus will guess at the file type.
+@xref{Document Groups}.
+
+@item G w
+@kindex G w (Group)
+@findex gnus-group-make-web-group
+@cindex DejaNews
+@cindex Alta Vista
+@cindex InReference
+@cindex nnweb
+Make an ephemeral group based on a web search
+(@code{gnus-group-make-web-group}). If you give a prefix to this
+command, make a solid group instead. You will be prompted for the
+search engine type and the search string. Valid search engine types
+include @code{dejanews}, @code{altavista} and @code{reference}.
+@xref{Web Searches}.
+
+@item G DEL
+@kindex G DEL (Group)
+@findex gnus-group-delete-group
+This function will delete the current group
+(@code{gnus-group-delete-group}). If given a prefix, this function will
+actually delete all the articles in the group, and forcibly remove the
+group itself from the face of the Earth. Use a prefix only if you are
+absolutely sure of what you are doing. This command can't be used on
+read-only groups (like @code{nntp} group), though.
+
+@item G V
+@kindex G V (Group)
+@findex gnus-group-make-empty-virtual
+Make a new, fresh, empty @code{nnvirtual} group
+(@code{gnus-group-make-empty-virtual}). @xref{Virtual Groups}.
+
+@item G v
+@kindex G v (Group)
+@findex gnus-group-add-to-virtual
+Add the current group to an @code{nnvirtual} group
+(@code{gnus-group-add-to-virtual}). Uses the process/prefix convention.
+@end table
+
+@xref{Select Methods} for more information on the various select
+methods.
+
+@vindex gnus-activate-foreign-newsgroups
+If @code{gnus-activate-foreign-newsgroups} is a positive number,
+Gnus will check all foreign groups with this level or lower at startup.
+This might take quite a while, especially if you subscribe to lots of
+groups from different @sc{nntp} servers.
+
+
+@node Group Parameters
+@section Group Parameters
+@cindex group parameters
+
+The group parameters store information local to a particular group:
+
+@table @code
+@item to-address
+@cindex to-address
+If the group parameter list contains an element that looks like
+@code{(to-address . "some@@where.com")}, that address will be used by
+the backend when doing followups and posts. This is primarily useful in
+mail groups that represent closed mailing lists---mailing lists where
+it's expected that everybody that writes to the mailing list is
+subscribed to it. Since using this parameter ensures that the mail only
+goes to the mailing list itself, it means that members won't receive two
+copies of your followups.
+
+Using @code{to-address} will actually work whether the group is foreign
+or not. Let's say there's a group on the server that is called
+@samp{fa.4ad-l}. This is a real newsgroup, but the server has gotten
+the articles from a mail-to-news gateway. Posting directly to this
+group is therefore impossible---you have to send mail to the mailing
+list address instead.
+
+@item to-list
+@cindex to-list
+If the group parameter list has an element that looks like
+@code{(to-list . "some@@where.com")}, that address will be used when
+doing a @kbd{a} in that group. It is totally ignored when doing a
+followup---except that if it is present in a news group, you'll get mail
+group semantics when doing @kbd{f}.
+
+If you do an @kbd{a} command in a mail group and you don't have a
+@code{to-list} group parameter, one will be added automatically upon
+sending the message.
+
+@item visible
+@cindex visible
+If the group parameter list has the element @code{(visible . t)},
+that group will always be visible in the Group buffer, regardless
+of whether it has any unread articles.
+
+@item broken-reply-to
+@cindex broken-reply-to
+Elements like @code{(broken-reply-to . t)} signals that @code{Reply-To}
+headers in this group are to be ignored. This can be useful if you're
+reading a mailing list group where the listserv has inserted
+@code{Reply-To} headers that point back to the listserv itself. This is
+broken behavior. So there!
+
+@item to-group
+@cindex to-group
+Elements like @code{(to-group . "some.group.name")} means that all
+posts in that group will be sent to @code{some.group.name}.
+
+@item newsgroup
+@cindex newsgroup
+If this symbol is present in the group parameter list, Gnus will treat
+all responses as if they were responses to news articles. This can be
+useful if you have a mail group that's really a mirror of a news group.
+
+@item gcc-self
+@cindex gcc-self
+If this symbol is present in the group parameter list and set to
+@code{t}, newly composed messages will be @code{Gcc}'d to the current
+group. If it is present and set to @code{none}, no @code{Gcc:} header
+will be generated, if it is present and a string, this string will be
+inserted literally as a @code{gcc} header (this symbol takes precedence
+over any default @code{Gcc} rules as described later). @xref{Archived
+Messages}
+
+@item auto-expire
+@cindex auto-expire
+If the group parameter has an element that looks like @code{(auto-expire
+. t)}, all articles read will be marked as expirable. For an
+alternative approach, @pxref{Expiring Mail}.
+
+@item total-expire
+@cindex total-expire
+If the group parameter has an element that looks like
+@code{(total-expire . t)}, all read articles will be put through the
+expiry process, even if they are not marked as expirable. Use with
+caution. Unread, ticked and dormant articles are not eligible for
+expiry.
+
+@item expiry-wait
+@cindex expiry-wait
+@vindex nnmail-expiry-wait-function
+If the group parameter has an element that looks like @code{(expiry-wait
+. 10)}, this value will override any @code{nnmail-expiry-wait} and
+@code{nnmail-expiry-wait-function} when expiring expirable messages.
+The value can either be a number of days (not necessarily an integer) or
+the symbols @code{never} or @code{immediate}.
+
+@item score-file
+@cindex score file group parameter
+Elements that look like @code{(score-file . "file")} will make
+@file{file} into the current adaptive score file for the group in
+question. All adaptive score entries will be put into this file.
+
+@item adapt-file
+@cindex adapt file group parameter
+Elements that look like @code{(adapt-file . "file")} will make
+@file{file} into the current adaptive file for the group in question.
+All adaptive score entries will be put into this file.
+
+@item admin-address
+When unsubscribing from a mailing list you should never send the
+unsubscription notice to the mailing list itself. Instead, you'd send
+messages to the administrative address. This parameter allows you to
+put the admin address somewhere convenient.
+
+@item display
+Elements that look like @code{(display . MODE)} say which articles to
+display on entering the group. Valid values are:
+
+@table @code
+@item all
+Display all articles, both read and unread.
+
+@item default
+Display the default visible articles, which normally includes unread and
+ticked articles.
+@end table
+
+@item comment
+Elements that look like @code{(comment . "This is a comment")}
+are arbitrary comments on the group. They are currently ignored by
+Gnus, but provide a place for you to store information on particular
+groups.
+
+@item @var{(variable form)}
+You can use the group parameters to set variables local to the group you
+are entering. If you want to turn threading off in @samp{news.answers},
+you could put @code{(gnus-show-threads nil)} in the group parameters of
+that group. @code{gnus-show-threads} will be made into a local variable
+in the summary buffer you enter, and the form @code{nil} will be
+@code{eval}ed there.
+
+This can also be used as a group-specific hook function, if you'd like.
+If you want to hear a beep when you enter a group, you could put
+something like @code{(dummy-variable (ding))} in the parameters of that
+group. @code{dummy-variable} will be set to the result of the
+@code{(ding)} form, but who cares?
+
+@end table
+
+Use the @kbd{G p} command to edit group parameters of a group.
+
+@pxref{Topic Parameters}.
+
+Here's an example group parameter list:
+
+@example
+((to-address . "ding@@gnus.org")
+ (auto-expiry . t))
+@end example
+
+
+@node Listing Groups
+@section Listing Groups
+@cindex group listing
+
+These commands all list various slices of the groups available.
+
+@table @kbd
+
+@item l
+@itemx A s
+@kindex A s (Group)
+@kindex l (Group)
+@findex gnus-group-list-groups
+List all groups that have unread articles
+(@code{gnus-group-list-groups}). If the numeric prefix is used, this
+command will list only groups of level ARG and lower. By default, it
+only lists groups of level five (i. e.,
+@code{gnus-group-default-list-level}) or lower (i.e., just subscribed
+groups).
+
+@item L
+@itemx A u
+@kindex A u (Group)
+@kindex L (Group)
+@findex gnus-group-list-all-groups
+List all groups, whether they have unread articles or not
+(@code{gnus-group-list-all-groups}). If the numeric prefix is used,
+this command will list only groups of level ARG and lower. By default,
+it lists groups of level seven or lower (i.e., just subscribed and
+unsubscribed groups).
+
+@item A l
+@kindex A l (Group)
+@findex gnus-group-list-level
+List all unread groups on a specific level
+(@code{gnus-group-list-level}). If given a prefix, also list the groups
+with no unread articles.
+
+@item A k
+@kindex A k (Group)
+@findex gnus-group-list-killed
+List all killed groups (@code{gnus-group-list-killed}). If given a
+prefix argument, really list all groups that are available, but aren't
+currently (un)subscribed. This could entail reading the active file
+from the server.
+
+@item A z
+@kindex A z (Group)
+@findex gnus-group-list-zombies
+List all zombie groups (@code{gnus-group-list-zombies}).
+
+@item A m
+@kindex A m (Group)
+@findex gnus-group-list-matching
+List all unread, subscribed groups with names that match a regexp
+(@code{gnus-group-list-matching}).
+
+@item A M
+@kindex A M (Group)
+@findex gnus-group-list-all-matching
+List groups that match a regexp (@code{gnus-group-list-all-matching}).
+
+@item A A
+@kindex A A (Group)
+@findex gnus-group-list-active
+List absolutely all groups in the active file(s) of the
+server(s) you are connected to (@code{gnus-group-list-active}). This
+might very well take quite a while. It might actually be a better idea
+to do a @kbd{A M} to list all matching, and just give @samp{.} as the
+thing to match on. Also note that this command may list groups that
+don't exist (yet)---these will be listed as if they were killed groups.
+Take the output with some grains of salt.
+
+@item A a
+@kindex A a (Group)
+@findex gnus-group-apropos
+List all groups that have names that match a regexp
+(@code{gnus-group-apropos}).
+
+@item A d
+@kindex A d (Group)
+@findex gnus-group-description-apropos
+List all groups that have names or descriptions that match a regexp
+(@code{gnus-group-description-apropos}).
+
+@end table
+
+@vindex gnus-permanently-visible-groups
+@cindex visible group parameter
+Groups that match the @code{gnus-permanently-visible-groups} regexp will
+always be shown, whether they have unread articles or not. You can also
+add the @code{visible} element to the group parameters in question to
+get the same effect.
+
+@vindex gnus-list-groups-with-ticked-articles
+Groups that have just ticked articles in it are normally listed in the
+group buffer. If @code{gnus-list-groups-with-ticked-articles} is
+@code{nil}, these groups will be treated just like totally empty
+groups. It is @code{t} by default.
+
+
+@node Sorting Groups
+@section Sorting Groups
+@cindex sorting groups
+
+@kindex C-c C-s (Group)
+@findex gnus-group-sort-groups
+@vindex gnus-group-sort-function
+The @kbd{C-c C-s} (@code{gnus-group-sort-groups}) command sorts the
+group buffer according to the function(s) given by the
+@code{gnus-group-sort-function} variable. Available sorting functions
+include:
+
+@table @code
+
+@item gnus-group-sort-by-alphabet
+@findex gnus-group-sort-by-alphabet
+Sort the group names alphabetically. This is the default.
+
+@item gnus-group-sort-by-real-name
+@findex gnus-group-sort-by-real-name
+Sort the group alphabetically on the real (unprefixed) group names.
+
+@item gnus-group-sort-by-level
+@findex gnus-group-sort-by-level
+Sort by group level.
+
+@item gnus-group-sort-by-score
+@findex gnus-group-sort-by-score
+Sort by group score.
+
+@item gnus-group-sort-by-rank
+@findex gnus-group-sort-by-rank
+Sort by group score and then the group level. The level and the score
+are, when taken together, the group's @dfn{rank}.
+
+@item gnus-group-sort-by-unread
+@findex gnus-group-sort-by-unread
+Sort by number of unread articles.
+
+@item gnus-group-sort-by-method
+@findex gnus-group-sort-by-method
+Sort alphabetically on the select method.
+
+
+@end table
+
+@code{gnus-group-sort-function} can also be a list of sorting
+functions. In that case, the most significant sort key function must be
+the last one.
+
+
+There are also a number of commands for sorting directly according to
+some sorting criteria:
+
+@table @kbd
+@item G S a
+@kindex G S a (Group)
+@findex gnus-group-sort-groups-by-alphabet
+Sort the group buffer alphabetically by group name
+(@code{gnus-group-sort-groups-by-alphabet}).
+
+@item G S u
+@kindex G S u (Group)
+@findex gnus-group-sort-groups-by-unread
+Sort the group buffer by the number of unread articles
+(@code{gnus-group-sort-groups-by-unread}).
+
+@item G S l
+@kindex G S l (Group)
+@findex gnus-group-sort-groups-by-level
+Sort the group buffer by group level
+(@code{gnus-group-sort-groups-by-level}).
+
+@item G S v
+@kindex G S v (Group)
+@findex gnus-group-sort-groups-by-score
+Sort the group buffer by group score
+(@code{gnus-group-sort-groups-by-score}).
+
+@item G S r
+@kindex G S r (Group)
+@findex gnus-group-sort-groups-by-rank
+Sort the group buffer by group rank
+(@code{gnus-group-sort-groups-by-rank}).
+
+@item G S m
+@kindex G S m (Group)
+@findex gnus-group-sort-groups-by-method
+Sort the group buffer alphabetically by backend name
+(@code{gnus-group-sort-groups-by-method}).
+
+@end table
+
+When given a prefix, all these commands will sort in reverse order.
+
+You can also sort a subset of the groups:
+
+@table @kbd
+@item G P a
+@kindex G P a (Group)
+@findex gnus-group-sort-selected-groups-by-alphabet
+Sort the process/prefixed groups in the group buffer alphabetically by
+group name (@code{gnus-group-sort-selected-groups-by-alphabet}).
+
+@item G P u
+@kindex G P u (Group)
+@findex gnus-group-sort-selected-groups-by-unread
+Sort the process/prefixed groups in the group buffer by the number of
+unread articles (@code{gnus-group-sort-selected-groups-by-unread}).
+
+@item G P l
+@kindex G P l (Group)
+@findex gnus-group-sort-selected-groups-by-level
+Sort the process/prefixed groups in the group buffer by group level
+(@code{gnus-group-sort-selected-groups-by-level}).
+
+@item G P v
+@kindex G P v (Group)
+@findex gnus-group-sort-selected-groups-by-score
+Sort the process/prefixed groups in the group buffer by group score
+(@code{gnus-group-sort-selected-groups-by-score}).
+
+@item G P r
+@kindex G P r (Group)
+@findex gnus-group-sort-selected-groups-by-rank
+Sort the process/prefixed groups in the group buffer by group rank
+(@code{gnus-group-sort-selected-groups-by-rank}).
+
+@item G P m
+@kindex G P m (Group)
+@findex gnus-group-sort-selected-groups-by-method
+Sort the process/prefixed groups in the group buffer alphabetically by
+backend name (@code{gnus-group-sort-selected-groups-by-method}).
+
+@end table
+
+
+
+@node Group Maintenance
+@section Group Maintenance
+@cindex bogus groups
+
+@table @kbd
+@item b
+@kindex b (Group)
+@findex gnus-group-check-bogus-groups
+Find bogus groups and delete them
+(@code{gnus-group-check-bogus-groups}).
+
+@item F
+@kindex F (Group)
+@findex gnus-group-find-new-groups
+Find new groups and process them (@code{gnus-group-find-new-groups}).
+If given a prefix, use the @code{ask-server} method to query the server
+for new groups.
+
+@item C-c C-x
+@kindex C-c C-x (Group)
+@findex gnus-group-expire-articles
+Run all expirable articles in the current group through the expiry
+process (if any) (@code{gnus-group-expire-articles}).
+
+@item C-c M-C-x
+@kindex C-c M-C-x (Group)
+@findex gnus-group-expire-all-groups
+Run all articles in all groups through the expiry process
+(@code{gnus-group-expire-all-groups}).
+
+@end table
+
+
+@node Browse Foreign Server
+@section Browse Foreign Server
+@cindex foreign servers
+@cindex browsing servers
+
+@table @kbd
+@item B
+@kindex B (Group)
+@findex gnus-group-browse-foreign-server
+You will be queried for a select method and a server name. Gnus will
+then attempt to contact this server and let you browse the groups there
+(@code{gnus-group-browse-foreign-server}).
+@end table
+
+@findex gnus-browse-mode
+A new buffer with a list of available groups will appear. This buffer
+will use the @code{gnus-browse-mode}. This buffer looks a bit (well,
+a lot) like a normal group buffer.
+
+Here's a list of keystrokes available in the browse mode:
+
+@table @kbd
+@item n
+@kindex n (Browse)
+@findex gnus-group-next-group
+Go to the next group (@code{gnus-group-next-group}).
+
+@item p
+@kindex p (Browse)
+@findex gnus-group-prev-group
+Go to the previous group (@code{gnus-group-prev-group}).
+
+@item SPACE
+@kindex SPACE (Browse)
+@findex gnus-browse-read-group
+Enter the current group and display the first article
+(@code{gnus-browse-read-group}).
+
+@item RET
+@kindex RET (Browse)
+@findex gnus-browse-select-group
+Enter the current group (@code{gnus-browse-select-group}).
+
+@item u
+@kindex u (Browse)
+@findex gnus-browse-unsubscribe-current-group
+Unsubscribe to the current group, or, as will be the case here,
+subscribe to it (@code{gnus-browse-unsubscribe-current-group}).
+
+@item l
+@itemx q
+@kindex q (Browse)
+@kindex l (Browse)
+@findex gnus-browse-exit
+Exit browse mode (@code{gnus-browse-exit}).
+
+@item ?
+@kindex ? (Browse)
+@findex gnus-browse-describe-briefly
+Describe browse mode briefly (well, there's not much to describe, is
+there) (@code{gnus-browse-describe-briefly}).
+@end table
+
+
+@node Exiting Gnus
+@section Exiting Gnus
+@cindex exiting Gnus
+
+Yes, Gnus is ex(c)iting.
+
+@table @kbd
+@item z
+@kindex z (Group)
+@findex gnus-group-suspend
+Suspend Gnus (@code{gnus-group-suspend}). This doesn't really exit Gnus,
+but it kills all buffers except the Group buffer. I'm not sure why this
+is a gain, but then who am I to judge?
+
+@item q
+@kindex q (Group)
+@findex gnus-group-exit
+@c @icon{gnus-group-exit}
+Quit Gnus (@code{gnus-group-exit}).
+
+@item Q
+@kindex Q (Group)
+@findex gnus-group-quit
+Quit Gnus without saving the @file{.newsrc} files (@code{gnus-group-quit}).
+The dribble file will be saved, though (@pxref{Auto Save}).
+@end table
+
+@vindex gnus-exit-gnus-hook
+@vindex gnus-suspend-gnus-hook
+@code{gnus-suspend-gnus-hook} is called when you suspend Gnus and
+@code{gnus-exit-gnus-hook} is called when you quit Gnus, while
+@code{gnus-after-exiting-gnus-hook} is called as the final item when
+exiting Gnus.
+
+@findex gnus-unload
+@cindex unloading
+If you wish to completely unload Gnus and all its adherents, you can use
+the @code{gnus-unload} command. This command is also very handy when
+trying to customize meta-variables.
+
+Note:
+
+@quotation
+Miss Lisa Cannifax, while sitting in English class, felt her feet go
+numbly heavy and herself fall into a hazy trance as the boy sitting
+behind her drew repeated lines with his pencil across the back of her
+plastic chair.
+@end quotation
+
+
+@node Group Topics
+@section Group Topics
+@cindex topics
+
+If you read lots and lots of groups, it might be convenient to group
+them hierarchically according to topics. You put your Emacs groups over
+here, your sex groups over there, and the rest (what, two groups or so?)
+you put in some misc section that you never bother with anyway. You can
+even group the Emacs sex groups as a sub-topic to either the Emacs
+groups or the sex groups---or both! Go wild!
+
+@iftex
+@iflatex
+\gnusfigure{Group Topics}{400}{
+\put(75,50){\epsfig{figure=tmp/group-topic.ps,height=9cm}}
+}
+@end iflatex
+@end iftex
+
+Here's an example:
+
+@example
+Gnus
+ Emacs -- I wuw it!
+ 3: comp.emacs
+ 2: alt.religion.emacs
+ Naughty Emacs
+ 452: alt.sex.emacs
+ 0: comp.talk.emacs.recovery
+ Misc
+ 8: comp.binaries.fractals
+ 13: comp.sources.unix
+@end example
+
+@findex gnus-topic-mode
+@kindex t (Group)
+To get this @emph{fab} functionality you simply turn on (ooh!) the
+@code{gnus-topic} minor mode---type @kbd{t} in the group buffer. (This
+is a toggling command.)
+
+Go ahead, just try it. I'll still be here when you get back. La de
+dum... Nice tune, that... la la la... What, you're back? Yes, and now
+press @kbd{l}. There. All your groups are now listed under
+@samp{misc}. Doesn't that make you feel all warm and fuzzy? Hot and
+bothered?
+
+If you want this permanently enabled, you should add that minor mode to
+the hook for the group mode:
+
+@lisp
+(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
+@end lisp
+
+@menu
+* Topic Variables:: How to customize the topics the Lisp Way.
+* Topic Commands:: Interactive E-Z commands.
+* Topic Sorting:: Sorting each topic individually.
+* Topic Topology:: A map of the world.
+* Topic Parameters:: Parameters that apply to all groups in a topic.
+@end menu
+
+
+@node Topic Variables
+@subsection Topic Variables
+@cindex topic variables
+
+Now, if you select a topic, it will fold/unfold that topic, which is
+really neat, I think.
+
+@vindex gnus-topic-line-format
+The topic lines themselves are created according to the
+@code{gnus-topic-line-format} variable (@pxref{Formatting Variables}).
+Valid elements are:
+
+@table @samp
+@item i
+Indentation.
+@item n
+Topic name.
+@item v
+Visibility.
+@item l
+Level.
+@item g
+Number of groups in the topic.
+@item a
+Number of unread articles in the topic.
+@item A
+Number of unread articles in the topic and all its subtopics.
+@end table
+
+@vindex gnus-topic-indent-level
+Each sub-topic (and the groups in the sub-topics) will be indented with
+@code{gnus-topic-indent-level} times the topic level number of spaces.
+The default is 2.
+
+@vindex gnus-topic-mode-hook
+@code{gnus-topic-mode-hook} is called in topic minor mode buffers.
+
+@vindex gnus-topic-display-empty-topics
+The @code{gnus-topic-display-empty-topics} says whether to display even
+topics that have no unread articles in them. The default is @code{t}.
+
+
+@node Topic Commands
+@subsection Topic Commands
+@cindex topic commands
+
+When the topic minor mode is turned on, a new @kbd{T} submap will be
+available. In addition, a few of the standard keys change their
+definitions slightly.
+
+@table @kbd
+
+@item T n
+@kindex T n (Topic)
+@findex gnus-topic-create-topic
+Prompt for a new topic name and create it
+(@code{gnus-topic-create-topic}).
+
+@item T m
+@kindex T m (Topic)
+@findex gnus-topic-move-group
+Move the current group to some other topic
+(@code{gnus-topic-move-group}). This command uses the process/prefix
+convention (@pxref{Process/Prefix}).
+
+@item T c
+@kindex T c (Topic)
+@findex gnus-topic-copy-group
+Copy the current group to some other topic
+(@code{gnus-topic-copy-group}). This command uses the process/prefix
+convention (@pxref{Process/Prefix}).
+
+@item T D
+@kindex T D (Topic)
+@findex gnus-topic-remove-group
+Remove a group from the current topic (@code{gnus-topic-remove-group}).
+This command uses the process/prefix convention
+(@pxref{Process/Prefix}).
+
+@item T M
+@kindex T M (Topic)
+@findex gnus-topic-move-matching
+Move all groups that match some regular expression to a topic
+(@code{gnus-topic-move-matching}).
+
+@item T C
+@kindex T C (Topic)
+@findex gnus-topic-copy-matching
+Copy all groups that match some regular expression to a topic
+(@code{gnus-topic-copy-matching}).
+
+@item T h
+@kindex T h (Topic)
+@findex gnus-topic-toggle-display-empty-topics
+Toggle hiding empty topics
+(@code{gnus-topic-toggle-display-empty-topics}).
+
+@item T #
+@kindex T # (Topic)
+@findex gnus-topic-mark-topic
+Mark all groups in the current topic with the process mark
+(@code{gnus-topic-mark-topic}).
+
+@item T M-#
+@kindex T M-# (Topic)
+@findex gnus-topic-unmark-topic
+Remove the process mark from all groups in the current topic
+(@code{gnus-topic-unmark-topic}).
+
+@item RET
+@kindex RET (Topic)
+@findex gnus-topic-select-group
+@itemx SPACE
+Either select a group or fold a topic (@code{gnus-topic-select-group}).
+When you perform this command on a group, you'll enter the group, as
+usual. When done on a topic line, the topic will be folded (if it was
+visible) or unfolded (if it was folded already). So it's basically a
+toggling command on topics. In addition, if you give a numerical
+prefix, group on that level (and lower) will be displayed.
+
+@item T TAB
+@kindex T TAB (Topic)
+@findex gnus-topic-indent
+``Indent'' the current topic so that it becomes a sub-topic of the
+previous topic (@code{gnus-topic-indent}). If given a prefix,
+``un-indent'' the topic instead.
+
+@item C-k
+@kindex C-k (Topic)
+@findex gnus-topic-kill-group
+Kill a group or topic (@code{gnus-topic-kill-group}). All groups in the
+topic will be removed along with the topic.
+
+@item C-y
+@kindex C-y (Topic)
+@findex gnus-topic-yank-group
+Yank the previously killed group or topic
+(@code{gnus-topic-yank-group}). Note that all topics will be yanked
+before all groups.
+
+@item T r
+@kindex T r (Topic)
+@findex gnus-topic-rename
+Rename a topic (@code{gnus-topic-rename}).
+
+@item T DEL
+@kindex T DEL (Topic)
+@findex gnus-topic-delete
+Delete an empty topic (@code{gnus-topic-delete}).
+
+@item A T
+@kindex A T (Topic)
+@findex gnus-topic-list-active
+List all groups that Gnus knows about in a topics-ified way
+(@code{gnus-topic-list-active}).
+
+@item G p
+@kindex G p (Topic)
+@findex gnus-topic-edit-parameters
+@cindex group parameters
+@cindex topic parameters
+@cindex parameters
+Edit the topic parameters (@code{gnus-topic-edit-parameters}).
+@xref{Topic Parameters}.
+
+@end table
+
+
+@node Topic Sorting
+@subsection Topic Sorting
+@cindex topic sorting
+
+You can sort the groups in each topic individually with the following
+commands:
+
+
+@table @kbd
+@item T S a
+@kindex T S a (Topic)
+@findex gnus-topic-sort-groups-by-alphabet
+Sort the current topic alphabetically by group name
+(@code{gnus-topic-sort-groups-by-alphabet}).
+
+@item T S u
+@kindex T S u (Topic)
+@findex gnus-topic-sort-groups-by-unread
+Sort the current topic by the number of unread articles
+(@code{gnus-topic-sort-groups-by-unread}).
+
+@item T S l
+@kindex T S l (Topic)
+@findex gnus-topic-sort-groups-by-level
+Sort the current topic by group level
+(@code{gnus-topic-sort-groups-by-level}).
+
+@item T S v
+@kindex T S v (Topic)
+@findex gnus-topic-sort-groups-by-score
+Sort the current topic by group score
+(@code{gnus-topic-sort-groups-by-score}).
+
+@item T S r
+@kindex T S r (Topic)
+@findex gnus-topic-sort-groups-by-rank
+Sort the current topic by group rank
+(@code{gnus-topic-sort-groups-by-rank}).
+
+@item T S m
+@kindex T S m (Topic)
+@findex gnus-topic-sort-groups-by-method
+Sort the current topic alphabetically by backend name
+(@code{gnus-topic-sort-groups-by-method}).
+
+@end table
+
+@xref{Sorting Groups} for more information about group sorting.
+
+
+@node Topic Topology
+@subsection Topic Topology
+@cindex topic topology
+@cindex topology
+
+So, let's have a look at an example group buffer:
+
+@example
+Gnus
+ Emacs -- I wuw it!
+ 3: comp.emacs
+ 2: alt.religion.emacs
+ Naughty Emacs
+ 452: alt.sex.emacs
+ 0: comp.talk.emacs.recovery
+ Misc
+ 8: comp.binaries.fractals
+ 13: comp.sources.unix
+@end example
+
+So, here we have one top-level topic (@samp{Gnus}), two topics under
+that, and one sub-topic under one of the sub-topics. (There is always
+just one (1) top-level topic). This topology can be expressed as
+follows:
+
+@lisp
+(("Gnus" visible)
+ (("Emacs -- I wuw it!" visible)
+ (("Naughty Emacs" visible)))
+ (("Misc" visible)))
+@end lisp
+
+@vindex gnus-topic-topology
+This is in fact how the variable @code{gnus-topic-topology} would look
+for the display above. That variable is saved in the @file{.newsrc.eld}
+file, and shouldn't be messed with manually---unless you really want
+to. Since this variable is read from the @file{.newsrc.eld} file,
+setting it in any other startup files will have no effect.
+
+This topology shows what topics are sub-topics of what topics (right),
+and which topics are visible. Two settings are currently
+allowed---@code{visible} and @code{invisible}.
+
+
+@node Topic Parameters
+@subsection Topic Parameters
+@cindex topic parameters
+
+All groups in a topic will inherit group parameters from the parent (and
+ancestor) topic parameters. All valid group parameters are valid topic
+parameters (@pxref{Group Parameters}).
+
+Group parameters (of course) override topic parameters, and topic
+parameters in sub-topics override topic parameters in super-topics. You
+know. Normal inheritance rules. (@dfn{Rules} is here a noun, not a
+verb, although you may feel free to disagree with me here.)
+
+@example
+Gnus
+ Emacs
+ 3: comp.emacs
+ 2: alt.religion.emacs
+ 452: alt.sex.emacs
+ Relief
+ 452: alt.sex.emacs
+ 0: comp.talk.emacs.recovery
+ Misc
+ 8: comp.binaries.fractals
+ 13: comp.sources.unix
+ 452: alt.sex.emacs
+@end example
+
+The @samp{Emacs} topic has the topic parameter @code{(score-file
+. "emacs.SCORE")}; the @samp{Relief} topic has the topic parameter
+@code{(score-file . "relief.SCORE")}; and the @samp{Misc} topic has the
+topic parameter @code{(score-file . "emacs.SCORE")}. In addition,
+@samp{alt.religion.emacs} has the group parameter @code{(score-file
+. "religion.SCORE")}.
+
+Now, when you enter @samp{alt.sex.emacs} in the @samp{Relief} topic, you
+will get the @file{relief.SCORE} home score file. If you enter the same
+group in the @samp{Emacs} topic, you'll get the @file{emacs.SCORE} home
+score file. If you enter the group @samp{alt.religion.emacs}, you'll
+get the @file{religion.SCORE} home score file.
+
+This seems rather simple and self-evident, doesn't it? Well, yes. But
+there are some problems, especially with the @code{total-expiry}
+parameter. Say you have a mail group in two topics; one with
+@code{total-expiry} and one without. What happens when you do @kbd{M-x
+gnus-expire-all-expirable-groups}? Gnus has no way of telling which one
+of these topics you mean to expire articles from, so anything may
+happen. In fact, I hereby declare that it is @dfn{undefined} what
+happens. You just have to be careful if you do stuff like that.
+
+
+@node Misc Group Stuff
+@section Misc Group Stuff
+
+@menu
+* Scanning New Messages:: Asking Gnus to see whether new messages have arrived.
+* Group Information:: Information and help on groups and Gnus.
+* Group Timestamp:: Making Gnus keep track of when you last read a group.
+* File Commands:: Reading and writing the Gnus files.
+@end menu
+
+@table @kbd
+
+@item ^
+@kindex ^ (Group)
+@findex gnus-group-enter-server-mode
+Enter the server buffer (@code{gnus-group-enter-server-mode}).
+@xref{The Server Buffer}.
+
+@item a
+@kindex a (Group)
+@findex gnus-group-post-news
+Post an article to a group (@code{gnus-group-post-news}). If given a
+prefix, the current group name will be used as the default.
+
+@item m
+@kindex m (Group)
+@findex gnus-group-mail
+Mail a message somewhere (@code{gnus-group-mail}).
+
+@end table
+
+Variables for the group buffer:
+
+@table @code
+
+@item gnus-group-mode-hook
+@vindex gnus-group-mode-hook
+is called after the group buffer has been
+created.
+
+@item gnus-group-prepare-hook
+@vindex gnus-group-prepare-hook
+is called after the group buffer is
+generated. It may be used to modify the buffer in some strange,
+unnatural way.
+
+@item gnus-permanently-visible-groups
+@vindex gnus-permanently-visible-groups
+Groups matching this regexp will always be listed in the group buffer,
+whether they are empty or not.
+
+@end table
+
+
+@node Scanning New Messages
+@subsection Scanning New Messages
+@cindex new messages
+@cindex scanning new news
+
+@table @kbd
+
+@item g
+@kindex g (Group)
+@findex gnus-group-get-new-news
+@c @icon{gnus-group-get-new-news}
+Check the server(s) for new articles. If the numerical prefix is used,
+this command will check only groups of level @var{arg} and lower
+(@code{gnus-group-get-new-news}). If given a non-numerical prefix, this
+command will force a total re-reading of the active file(s) from the
+backend(s).
+
+@item M-g
+@kindex M-g (Group)
+@findex gnus-group-get-new-news-this-group
+@vindex gnus-goto-next-group-when-activating
+@c @icon{gnus-group-get-new-news-this-group}
+Check whether new articles have arrived in the current group
+(@code{gnus-group-get-new-news-this-group}).
+@code{gnus-goto-next-group-when-activating} says whether this command is
+to move point to the next group or not. It is @code{t} by default.
+
+@findex gnus-activate-all-groups
+@cindex activating groups
+@item C-c M-g
+@kindex C-c M-g (Group)
+Activate absolutely all groups (@code{gnus-activate-all-groups}).
+
+@item R
+@kindex R (Group)
+@cindex restarting
+@findex gnus-group-restart
+Restart Gnus (@code{gnus-group-restart}). This saves the @file{.newsrc}
+file(s), closes the connection to all servers, clears up all run-time
+Gnus variables, and then starts Gnus all over again.
+
+@end table
+
+@vindex gnus-get-new-news-hook
+@code{gnus-get-new-news-hook} is run just before checking for new news.
+
+@vindex gnus-after-getting-new-news-hook
+@code{gnus-after-getting-new-news-hook} is run after checking for new
+news.
+
+
+@node Group Information
+@subsection Group Information
+@cindex group information
+@cindex information on groups
+
+@table @kbd
+
+
+@item H f
+@kindex H f (Group)
+@findex gnus-group-fetch-faq
+@vindex gnus-group-faq-directory
+@cindex FAQ
+@cindex ange-ftp
+Try to fetch the FAQ for the current group
+(@code{gnus-group-fetch-faq}). Gnus will try to get the FAQ from
+@code{gnus-group-faq-directory}, which is usually a directory on a
+remote machine. This variable can also be a list of directories. In
+that case, giving a prefix to this command will allow you to choose
+between the various sites. @code{ange-ftp} (or @code{efs}) will be used
+for fetching the file.
+
+If fetching from the first site is unsuccessful, Gnus will attempt to go
+through @code{gnus-group-faq-directory} and try to open them one by one.
+
+@item H d
+@itemx C-c C-d
+@c @icon{gnus-group-describe-group}
+@kindex H d (Group)
+@kindex C-c C-d (Group)
+@cindex describing groups
+@cindex group description
+@findex gnus-group-describe-group
+Describe the current group (@code{gnus-group-describe-group}). If given
+a prefix, force Gnus to re-read the description from the server.
+
+@item M-d
+@kindex M-d (Group)
+@findex gnus-group-describe-all-groups
+Describe all groups (@code{gnus-group-describe-all-groups}). If given a
+prefix, force Gnus to re-read the description file from the server.
+
+@item H v
+@itemx V
+@kindex V (Group)
+@kindex H v (Group)
+@cindex version
+@findex gnus-version
+Display current Gnus version numbers (@code{gnus-version}).
+
+@item ?
+@kindex ? (Group)
+@findex gnus-group-describe-briefly
+Give a very short help message (@code{gnus-group-describe-briefly}).
+
+@item C-c C-i
+@kindex C-c C-i (Group)
+@cindex info
+@cindex manual
+@findex gnus-info-find-node
+Go to the Gnus info node (@code{gnus-info-find-node}).
+@end table
+
+
+@node Group Timestamp
+@subsection Group Timestamp
+@cindex timestamps
+@cindex group timestamps
+
+It can be convenient to let Gnus keep track of when you last read a
+group. To set the ball rolling, you should add
+@code{gnus-group-set-timestamp} to @code{gnus-select-group-hook}:
+
+@lisp
+(add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp)
+@end lisp
+
+After doing this, each time you enter a group, it'll be recorded.
+
+This information can be displayed in various ways---the easiest is to
+use the @samp{%d} spec in the group line format:
+
+@lisp
+(setq gnus-group-line-format
+ "%M\%S\%p\%P\%5y: %(%-40,40g%) %d\n")
+@end lisp
+
+This will result in lines looking like:
+
+@example
+* 0: mail.ding 19961002T012943
+ 0: custom 19961002T012713
+@end example
+
+As you can see, the date is displayed in compact ISO 8601 format. This
+may be a bit too much, so to just display the date, you could say
+something like:
+
+@lisp
+(setq gnus-group-line-format
+ "%M\%S\%p\%P\%5y: %(%-40,40g%) %6,6~(cut 2)d\n")
+@end lisp
+
+
+@node File Commands
+@subsection File Commands
+@cindex file commands
+
+@table @kbd
+
+@item r
+@kindex r (Group)
+@findex gnus-group-read-init-file
+@vindex gnus-init-file
+@cindex reading init file
+Re-read the init file (@code{gnus-init-file}, which defaults to
+@file{~/.gnus}) (@code{gnus-group-read-init-file}).
+
+@item s
+@kindex s (Group)
+@findex gnus-group-save-newsrc
+@cindex saving .newsrc
+Save the @file{.newsrc.eld} file (and @file{.newsrc} if wanted)
+(@code{gnus-group-save-newsrc}). If given a prefix, force saving the
+file(s) whether Gnus thinks it is necessary or not.
+
+@c @item Z
+@c @kindex Z (Group)
+@c @findex gnus-group-clear-dribble
+@c Clear the dribble buffer (@code{gnus-group-clear-dribble}).
+
+@end table
+
+
+@node The Summary Buffer
+@chapter The Summary Buffer
+@cindex summary buffer
+
+A line for each article is displayed in the summary buffer. You can
+move around, read articles, post articles and reply to articles.
+
+The most common way to a summary buffer is to select a group from the
+group buffer (@pxref{Selecting a Group}).
+
+You can have as many summary buffers open as you wish.
+
+@menu
+* Summary Buffer Format:: Deciding how the summary buffer is to look.
+* Summary Maneuvering:: Moving around the summary buffer.
+* Choosing Articles:: Reading articles.
+* Paging the Article:: Scrolling the current article.
+* Reply Followup and Post:: Posting articles.
+* Canceling and Superseding:: ``Whoops, I shouldn't have called him that.''
+* Marking Articles:: Marking articles as read, expirable, etc.
+* Limiting:: You can limit the summary buffer.
+* Threading:: How threads are made.
+* Sorting:: How articles and threads are sorted.
+* Asynchronous Fetching:: Gnus might be able to pre-fetch articles.
+* Article Caching:: You may store articles in a cache.
+* Persistent Articles:: Making articles expiry-resistant.
+* Article Backlog:: Having already read articles hang around.
+* Saving Articles:: Ways of customizing article saving.
+* Decoding Articles:: Gnus can treat series of (uu)encoded articles.
+* Article Treatment:: The article buffer can be mangled at will.
+* Article Commands:: Doing various things with the article buffer.
+* Summary Sorting:: Sorting the summary buffer in various ways.
+* Finding the Parent:: No child support? Get the parent.
+* Alternative Approaches:: Reading using non-default summaries.
+* Tree Display:: A more visual display of threads.
+* Mail Group Commands:: Some commands can only be used in mail groups.
+* Various Summary Stuff:: What didn't fit anywhere else.
+* Exiting the Summary Buffer:: Returning to the Group buffer.
+* Crosspost Handling:: How crossposted articles are dealt with.
+* Duplicate Suppression:: An alternative when crosspost handling fails.
+@end menu
+
+
+@node Summary Buffer Format
+@section Summary Buffer Format
+@cindex summary buffer format
+
+@iftex
+@iflatex
+\gnusfigure{The Summary Buffer}{180}{
+\put(0,0){\epsfig{figure=tmp/summary.ps,width=7.5cm}}
+\put(445,0){\makebox(0,0)[br]{\epsfig{figure=tmp/summary-article.ps,width=7.5cm}}}
+}
+@end iflatex
+@end iftex
+
+@menu
+* Summary Buffer Lines:: You can specify how summary lines should look.
+* Summary Buffer Mode Line:: You can say how the mode line should look.
+* Summary Highlighting:: Making the summary buffer all pretty and nice.
+@end menu
+
+@findex mail-extract-address-components
+@findex gnus-extract-address-components
+@vindex gnus-extract-address-components
+Gnus will use the value of the @code{gnus-extract-address-components}
+variable as a function for getting the name and address parts of a
+@code{From} header. Two pre-defined functions exist:
+@code{gnus-extract-address-components}, which is the default, quite
+fast, and too simplistic solution; and
+@code{mail-extract-address-components}, which works very nicely, but is
+slower. The default function will return the wrong answer in 5% of the
+cases. If this is unacceptable to you, use the other function instead.
+
+@vindex gnus-summary-same-subject
+@code{gnus-summary-same-subject} is a string indicating that the current
+article has the same subject as the previous. This string will be used
+with those specs that require it. The default is @samp{}.
+
+
+@node Summary Buffer Lines
+@subsection Summary Buffer Lines
+
+@vindex gnus-summary-line-format
+You can change the format of the lines in the summary buffer by changing
+the @code{gnus-summary-line-format} variable. It works along the same
+lines as a normal @code{format} string, with some extensions
+(@pxref{Formatting Variables}).
+
+The default string is @samp{%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n}.
+
+The following format specification characters are understood:
+
+@table @samp
+@item N
+Article number.
+@item S
+Subject string.
+@item s
+Subject if the article is the root of the thread or the previous article
+had a different subject, @code{gnus-summary-same-subject} otherwise.
+(@code{gnus-summary-same-subject} defaults to @samp{}.)
+@item F
+Full @code{From} header.
+@item n
+The name (from the @code{From} header).
+@item a
+The name (from the @code{From} header). This differs from the @code{n}
+spec in that it uses the function designated by the
+@code{gnus-extract-address-components} variable, which is slower, but
+may be more thorough.
+@item A
+The address (from the @code{From} header). This works the same way as
+the @code{a} spec.
+@item L
+Number of lines in the article.
+@item c
+Number of characters in the article.
+@item I
+Indentation based on thread level (@pxref{Customizing Threading}).
+@item T
+Nothing if the article is a root and lots of spaces if it isn't (it
+pushes everything after it off the screen).
+@item [
+Opening bracket, which is normally @samp{[}, but can also be @samp{<}
+for adopted articles (@pxref{Customizing Threading}).
+@item ]
+Closing bracket, which is normally @samp{]}, but can also be @samp{>}
+for adopted articles.
+@item >
+One space for each thread level.
+@item <
+Twenty minus thread level spaces.
+@item U
+Unread.
+@item R
+Replied.
+@item i
+Score as a number (@pxref{Scoring}).
+@item z
+@vindex gnus-summary-zcore-fuzz
+Zcore, @samp{+} if above the default level and @samp{-} if below the
+default level. If the difference between
+@code{gnus-summary-default-level} and the score is less than
+@code{gnus-summary-zcore-fuzz}, this spec will not be used.
+@item V
+Total thread score.
+@item x
+@code{Xref}.
+@item D
+@code{Date}.
+@item d
+The @code{Date} in @code{DD-MMM} format.
+@item o
+The @code{Date} in @var{YYYYMMDD}@code{T}@var{HHMMSS} format.
+@item M
+@code{Message-ID}.
+@item r
+@code{References}.
+@item t
+Number of articles in the current sub-thread. Using this spec will slow
+down summary buffer generation somewhat.
+@item e
+An @samp{=} (@code{gnus-not-empty-thread-mark}) will be displayed if the
+article has any children.
+@item P
+The line number.
+@item O
+Download mark.
+@item u
+User defined specifier. The next character in the format string should
+be a letter. Gnus will call the function
+@code{gnus-user-format-function-}@samp{X}, where @samp{X} is the letter
+following @samp{%u}. The function will be passed the current header as
+argument. The function should return a string, which will be inserted
+into the summary just like information from any other summary specifier.
+@end table
+
+The @samp{%U} (status), @samp{%R} (replied) and @samp{%z} (zcore) specs
+have to be handled with care. For reasons of efficiency, Gnus will
+compute what column these characters will end up in, and ``hard-code''
+that. This means that it is invalid to have these specs after a
+variable-length spec. Well, you might not be arrested, but your summary
+buffer will look strange, which is bad enough.
+
+The smart choice is to have these specs as far to the left as possible.
+(Isn't that the case with everything, though? But I digress.)
+
+This restriction may disappear in later versions of Gnus.
+
+
+@node Summary Buffer Mode Line
+@subsection Summary Buffer Mode Line
+
+@vindex gnus-summary-mode-line-format
+You can also change the format of the summary mode bar. Set
+@code{gnus-summary-mode-line-format} to whatever you like. The default
+is @samp{Gnus: %%b [%A] %Z}.
+
+Here are the elements you can play with:
+
+@table @samp
+@item G
+Group name.
+@item p
+Unprefixed group name.
+@item A
+Current article number.
+@item V
+Gnus version.
+@item U
+Number of unread articles in this group.
+@item e
+Number of unread articles in this group that aren't displayed in the
+summary buffer.
+@item Z
+A string with the number of unread and unselected articles represented
+either as @samp{<%U(+%e) more>} if there are both unread and unselected
+articles, and just as @samp{<%U more>} if there are just unread articles
+and no unselected ones.
+@item g
+Shortish group name. For instance, @samp{rec.arts.anime} will be
+shortened to @samp{r.a.anime}.
+@item S
+Subject of the current article.
+@item u
+User-defined spec (@pxref{User-Defined Specs}).
+@item s
+Name of the current score file (@pxref{Scoring}).
+@item d
+Number of dormant articles (@pxref{Unread Articles}).
+@item t
+Number of ticked articles (@pxref{Unread Articles}).
+@item r
+Number of articles that have been marked as read in this session.
+@item E
+Number of articles expunged by the score files.
+@end table
+
+
+@node Summary Highlighting
+@subsection Summary Highlighting
+
+@table @code
+
+@item gnus-visual-mark-article-hook
+@vindex gnus-visual-mark-article-hook
+This hook is run after selecting an article. It is meant to be used for
+highlighting the article in some way. It is not run if
+@code{gnus-visual} is @code{nil}.
+
+@item gnus-summary-update-hook
+@vindex gnus-summary-update-hook
+This hook is called when a summary line is changed. It is not run if
+@code{gnus-visual} is @code{nil}.
+
+@item gnus-summary-selected-face
+@vindex gnus-summary-selected-face
+This is the face (or @dfn{font} as some people call it) used to
+highlight the current article in the summary buffer.
+
+@item gnus-summary-highlight
+@vindex gnus-summary-highlight
+Summary lines are highlighted according to this variable, which is a
+list where the elements are of the format @var{(FORM . FACE)}. If you
+would, for instance, like ticked articles to be italic and high-scored
+articles to be bold, you could set this variable to something like
+@lisp
+(((eq mark gnus-ticked-mark) . italic)
+ ((> score default) . bold))
+@end lisp
+As you may have guessed, if @var{FORM} returns a non-@code{nil} value,
+@var{FACE} will be applied to the line.
+@end table
+
+
+@node Summary Maneuvering
+@section Summary Maneuvering
+@cindex summary movement
+
+All the straight movement commands understand the numeric prefix and
+behave pretty much as you'd expect.
+
+None of these commands select articles.
+
+@table @kbd
+@item G M-n
+@itemx M-n
+@kindex M-n (Summary)
+@kindex G M-n (Summary)
+@findex gnus-summary-next-unread-subject
+Go to the next summary line of an unread article
+(@code{gnus-summary-next-unread-subject}).
+
+@item G M-p
+@itemx M-p
+@kindex M-p (Summary)
+@kindex G M-p (Summary)
+@findex gnus-summary-prev-unread-subject
+Go to the previous summary line of an unread article
+(@code{gnus-summary-prev-unread-subject}).
+
+@item G j
+@itemx j
+@kindex j (Summary)
+@kindex G j (Summary)
+@findex gnus-summary-goto-article
+Ask for an article number or @code{Message-ID}, and then go to that
+article (@code{gnus-summary-goto-article}).
+
+@item G g
+@kindex G g (Summary)
+@findex gnus-summary-goto-subject
+Ask for an article number and then go to the summary line of that article
+without displaying the article (@code{gnus-summary-goto-subject}).
+@end table
+
+If Gnus asks you to press a key to confirm going to the next group, you
+can use the @kbd{C-n} and @kbd{C-p} keys to move around the group
+buffer, searching for the next group to read without actually returning
+to the group buffer.
+
+Variables related to summary movement:
+
+@table @code
+
+@vindex gnus-auto-select-next
+@item gnus-auto-select-next
+If you issue one of the movement commands (like @kbd{n}) and there are
+no more unread articles after the current one, Gnus will offer to go to
+the next group. If this variable is @code{t} and the next group is
+empty, Gnus will exit summary mode and return to the group buffer. If
+this variable is neither @code{t} nor @code{nil}, Gnus will select the
+next group, no matter whether it has any unread articles or not. As a
+special case, if this variable is @code{quietly}, Gnus will select the
+next group without asking for confirmation. If this variable is
+@code{almost-quietly}, the same will happen only if you are located on
+the last article in the group. Finally, if this variable is
+@code{slightly-quietly}, the @kbd{Z n} command will go to the next group
+without confirmation. Also @pxref{Group Levels}.
+
+@item gnus-auto-select-same
+@vindex gnus-auto-select-same
+If non-@code{nil}, all the movement commands will try to go to the next
+article with the same subject as the current. (@dfn{Same} here might
+mean @dfn{roughly equal}. See @code{gnus-summary-gather-subject-limit}
+for details (@pxref{Customizing Threading}).) This variable is not
+particularly useful if you use a threaded display.
+
+@item gnus-summary-check-current
+@vindex gnus-summary-check-current
+If non-@code{nil}, all the ``unread'' movement commands will not proceed
+to the next (or previous) article if the current article is unread.
+Instead, they will choose the current article.
+
+@item gnus-auto-center-summary
+@vindex gnus-auto-center-summary
+If non-@code{nil}, Gnus will keep the point in the summary buffer
+centered at all times. This makes things quite tidy, but if you have a
+slow network connection, or simply do not like this un-Emacsism, you can
+set this variable to @code{nil} to get the normal Emacs scrolling
+action. This will also inhibit horizontal re-centering of the summary
+buffer, which might make it more inconvenient to read extremely long
+threads.
+
+@end table
+
+
+@node Choosing Articles
+@section Choosing Articles
+@cindex selecting articles
+
+@menu
+* Choosing Commands:: Commands for choosing articles.
+* Choosing Variables:: Variables that influence these commands.
+@end menu
+
+
+@node Choosing Commands
+@subsection Choosing Commands
+
+None of the following movement commands understand the numeric prefix,
+and they all select and display an article.
+
+@table @kbd
+@item SPACE
+@kindex SPACE (Summary)
+@findex gnus-summary-next-page
+Select the current article, or, if that one's read already, the next
+unread article (@code{gnus-summary-next-page}).
+
+@item G n
+@itemx n
+@kindex n (Summary)
+@kindex G n (Summary)
+@findex gnus-summary-next-unread-article
+@c @icon{gnus-summary-next-unread}
+Go to next unread article (@code{gnus-summary-next-unread-article}).
+
+@item G p
+@itemx p
+@kindex p (Summary)
+@findex gnus-summary-prev-unread-article
+@c @icon{gnus-summary-prev-unread}
+Go to previous unread article (@code{gnus-summary-prev-unread-article}).
+
+@item G N
+@itemx N
+@kindex N (Summary)
+@kindex G N (Summary)
+@findex gnus-summary-next-article
+Go to the next article (@code{gnus-summary-next-article}).
+
+@item G P
+@itemx P
+@kindex P (Summary)
+@kindex G P (Summary)
+@findex gnus-summary-prev-article
+Go to the previous article (@code{gnus-summary-prev-article}).
+
+@item G C-n
+@kindex G C-n (Summary)
+@findex gnus-summary-next-same-subject
+Go to the next article with the same subject
+(@code{gnus-summary-next-same-subject}).
+
+@item G C-p
+@kindex G C-p (Summary)
+@findex gnus-summary-prev-same-subject
+Go to the previous article with the same subject
+(@code{gnus-summary-prev-same-subject}).
+
+@item G f
+@itemx .
+@kindex G f (Summary)
+@kindex . (Summary)
+@findex gnus-summary-first-unread-article
+Go to the first unread article
+(@code{gnus-summary-first-unread-article}).
+
+@item G b
+@itemx ,
+@kindex G b (Summary)
+@kindex , (Summary)
+@findex gnus-summary-best-unread-article
+Go to the article with the highest score
+(@code{gnus-summary-best-unread-article}).
+
+@item G l
+@itemx l
+@kindex l (Summary)
+@kindex G l (Summary)
+@findex gnus-summary-goto-last-article
+Go to the previous article read (@code{gnus-summary-goto-last-article}).
+
+@item G o
+@kindex G o (Summary)
+@findex gnus-summary-pop-article
+@cindex history
+@cindex article history
+Pop an article off the summary history and go to this article
+(@code{gnus-summary-pop-article}). This command differs from the
+command above in that you can pop as many previous articles off the
+history as you like. For a somewhat related issue (if you use this
+command a lot), @pxref{Article Backlog}.
+@end table
+
+
+@node Choosing Variables
+@subsection Choosing Variables
+
+Some variables relevant for moving and selecting articles:
+
+@table @code
+@item gnus-auto-extend-newsgroup
+@vindex gnus-auto-extend-newsgroup
+All the movement commands will try to go to the previous (or next)
+article, even if that article isn't displayed in the Summary buffer if
+this variable is non-@code{nil}. Gnus will then fetch the article from
+the server and display it in the article buffer.
+
+@item gnus-select-article-hook
+@vindex gnus-select-article-hook
+This hook is called whenever an article is selected. By default it
+exposes any threads hidden under the selected article.
+
+@item gnus-mark-article-hook
+@vindex gnus-mark-article-hook
+@findex gnus-summary-mark-unread-as-read
+@findex gnus-summary-mark-read-and-unread-as-read
+@findex gnus-unread-mark
+This hook is called whenever an article is selected. It is intended to
+be used for marking articles as read. The default value is
+@code{gnus-summary-mark-read-and-unread-as-read}, and will change the
+mark of almost any article you read to @code{gnus-unread-mark}. The
+only articles not affected by this function are ticked, dormant, and
+expirable articles. If you'd instead like to just have unread articles
+marked as read, you can use @code{gnus-summary-mark-unread-as-read}
+instead. It will leave marks like @code{gnus-low-score-mark},
+@code{gnus-del-mark} (and so on) alone.
+
+@end table
+
+
+@node Paging the Article
+@section Scrolling the Article
+@cindex article scrolling
+
+@table @kbd
+
+@item SPACE
+@kindex SPACE (Summary)
+@findex gnus-summary-next-page
+Pressing @kbd{SPACE} will scroll the current article forward one page,
+or, if you have come to the end of the current article, will choose the
+next article (@code{gnus-summary-next-page}).
+
+@item DEL
+@kindex DEL (Summary)
+@findex gnus-summary-prev-page
+Scroll the current article back one page (@code{gnus-summary-prev-page}).
+
+@item RET
+@kindex RET (Summary)
+@findex gnus-summary-scroll-up
+Scroll the current article one line forward
+(@code{gnus-summary-scroll-up}).
+
+@item A g
+@itemx g
+@kindex A g (Summary)
+@kindex g (Summary)
+@findex gnus-summary-show-article
+(Re)fetch the current article (@code{gnus-summary-show-article}). If
+given a prefix, fetch the current article, but don't run any of the
+article treatment functions. This will give you a ``raw'' article, just
+the way it came from the server.
+
+@item A <
+@itemx <
+@kindex < (Summary)
+@kindex A < (Summary)
+@findex gnus-summary-beginning-of-article
+Scroll to the beginning of the article
+(@code{gnus-summary-beginning-of-article}).
+
+@item A >
+@itemx >
+@kindex > (Summary)
+@kindex A > (Summary)
+@findex gnus-summary-end-of-article
+Scroll to the end of the article (@code{gnus-summary-end-of-article}).
+
+@item A s
+@itemx s
+@kindex A s (Summary)
+@kindex s (Summary)
+@findex gnus-summary-isearch-article
+Perform an isearch in the article buffer
+(@code{gnus-summary-isearch-article}).
+
+@end table
+
+
+@node Reply Followup and Post
+@section Reply, Followup and Post
+
+@menu
+* Summary Mail Commands:: Sending mail.
+* Summary Post Commands:: Sending news.
+@end menu
+
+
+@node Summary Mail Commands
+@subsection Summary Mail Commands
+@cindex mail
+@cindex composing mail
+
+Commands for composing a mail message:
+
+@table @kbd
+
+@item S r
+@itemx r
+@kindex S r (Summary)
+@kindex r (Summary)
+@findex gnus-summary-reply
+@c @icon{gnus-summary-mail-reply}
+@c @icon{gnus-summary-reply}
+Mail a reply to the author of the current article
+(@code{gnus-summary-reply}).
+
+@item S R
+@itemx R
+@kindex R (Summary)
+@kindex S R (Summary)
+@findex gnus-summary-reply-with-original
+@c @icon{gnus-summary-reply-with-original}
+Mail a reply to the author of the current article and include the
+original message (@code{gnus-summary-reply-with-original}). This
+command uses the process/prefix convention.
+
+@item S w
+@kindex S w (Summary)
+@findex gnus-summary-wide-reply
+Mail a wide reply to the author of the current article
+(@code{gnus-summary-wide-reply}). A @dfn{wide reply} is a reply that
+goes out to all people listed in the @code{To}, @code{From} (or
+@code{Reply-to}) and @code{Cc} headers.
+
+@item S W
+@kindex S W (Summary)
+@findex gnus-summary-wide-reply-with-original
+Mail a wide reply to the current article and include the original
+message (@code{gnus-summary-reply-with-original}). This command uses
+the process/prefix convention.
+
+@item S o m
+@kindex S o m (Summary)
+@findex gnus-summary-mail-forward
+@c @icon{gnus-summary-mail-forward}
+Forward the current article to some other person
+(@code{gnus-summary-mail-forward}). If given a prefix, include the full
+headers of the forwarded article.
+
+@item S m
+@itemx m
+@kindex m (Summary)
+@kindex S m (Summary)
+@findex gnus-summary-mail-other-window
+@c @icon{gnus-summary-mail-originate}
+Send a mail to some other person
+(@code{gnus-summary-mail-other-window}).
+
+@item S D b
+@kindex S D b (Summary)
+@findex gnus-summary-resend-bounced-mail
+@cindex bouncing mail
+If you have sent a mail, but the mail was bounced back to you for some
+reason (wrong address, transient failure), you can use this command to
+resend that bounced mail (@code{gnus-summary-resend-bounced-mail}). You
+will be popped into a mail buffer where you can edit the headers before
+sending the mail off again. If you give a prefix to this command, and
+the bounced mail is a reply to some other mail, Gnus will try to fetch
+that mail and display it for easy perusal of its headers. This might
+very well fail, though.
+
+@item S D r
+@kindex S D r (Summary)
+@findex gnus-summary-resend-message
+Not to be confused with the previous command,
+@code{gnus-summary-resend-message} will prompt you for an address to
+send the current message off to, and then send it to that place. The
+headers of the message won't be altered---but lots of headers that say
+@code{Resent-To}, @code{Resent-From} and so on will be added. This
+means that you actually send a mail to someone that has a @code{To}
+header that (probably) points to yourself. This will confuse people.
+So, natcherly you'll only do that if you're really eVIl.
+
+This command is mainly used if you have several accounts and want to
+ship a mail to a different account of yours. (If you're both
+@code{root} and @code{postmaster} and get a mail for @code{postmaster}
+to the @code{root} account, you may want to resend it to
+@code{postmaster}. Ordnung muß sein!
+
+This command understands the process/prefix convention
+(@pxref{Process/Prefix}).
+
+@item S O m
+@kindex S O m (Summary)
+@findex gnus-uu-digest-mail-forward
+Digest the current series (@pxref{Decoding Articles}) and forward the
+result using mail (@code{gnus-uu-digest-mail-forward}). This command
+uses the process/prefix convention (@pxref{Process/Prefix}).
+
+@item S M-c
+@kindex S M-c (Summary)
+@findex gnus-summary-mail-crosspost-complaint
+@cindex crossposting
+@cindex excessive crossposting
+Send a complaint about excessive crossposting to the author of the
+current article (@code{gnus-summary-mail-crosspost-complaint}).
+
+@findex gnus-crosspost-complaint
+This command is provided as a way to fight back agains the current
+crossposting pandemic that's sweeping Usenet. It will compose a reply
+using the @code{gnus-crosspost-complaint} variable as a preamble. This
+command understands the process/prefix convention
+(@pxref{Process/Prefix}) and will prompt you before sending each mail.
+
+@end table
+
+
+@node Summary Post Commands
+@subsection Summary Post Commands
+@cindex post
+@cindex composing news
+
+Commands for posting a news article:
+
+@table @kbd
+@item S p
+@itemx a
+@kindex a (Summary)
+@kindex S p (Summary)
+@findex gnus-summary-post-news
+@c @icon{gnus-summary-post-news}
+Post an article to the current group
+(@code{gnus-summary-post-news}).
+
+@item S f
+@itemx f
+@kindex f (Summary)
+@kindex S f (Summary)
+@findex gnus-summary-followup
+@c @icon{gnus-summary-followup}
+Post a followup to the current article (@code{gnus-summary-followup}).
+
+@item S F
+@itemx F
+@kindex S F (Summary)
+@kindex F (Summary)
+@c @icon{gnus-summary-followup-with-original}
+@findex gnus-summary-followup-with-original
+Post a followup to the current article and include the original message
+(@code{gnus-summary-followup-with-original}). This command uses the
+process/prefix convention.
+
+@item S n
+@kindex S n (Summary)
+@findex gnus-summary-followup-to-mail
+Post a followup to the current article via news, even if you got the
+message through mail (@code{gnus-summary-followup-to-mail}).
+
+@item S n
+@kindex S n (Summary)
+@findex gnus-summary-followup-to-mail
+Post a followup to the current article via news, even if you got the
+message through mail and include the original message
+(@code{gnus-summary-followup-to-mail-with-original}). This command uses
+the process/prefix convention.
+
+@item S o p
+@kindex S o p (Summary)
+@findex gnus-summary-post-forward
+Forward the current article to a newsgroup
+(@code{gnus-summary-post-forward}). If given a prefix, include the full
+headers of the forwarded article.
+
+@item S O p
+@kindex S O p (Summary)
+@findex gnus-uu-digest-post-forward
+@cindex digests
+@cindex making digests
+Digest the current series and forward the result to a newsgroup
+(@code{gnus-uu-digest-mail-forward}). This command uses the
+process/prefix convention.
+
+@item S u
+@kindex S u (Summary)
+@findex gnus-uu-post-news
+@c @icon{gnus-uu-post-news}
+Uuencode a file, split it into parts, and post it as a series
+(@code{gnus-uu-post-news}). (@pxref{Uuencoding and Posting}).
+@end table
+
+
+@node Canceling and Superseding
+@section Canceling Articles
+@cindex canceling articles
+@cindex superseding articles
+
+Have you ever written something, and then decided that you really,
+really, really wish you hadn't posted that?
+
+Well, you can't cancel mail, but you can cancel posts.
+
+@findex gnus-summary-cancel-article
+@kindex C (Summary)
+@c @icon{gnus-summary-cancel-article}
+Find the article you wish to cancel (you can only cancel your own
+articles, so don't try any funny stuff). Then press @kbd{C} or @kbd{S
+c} (@code{gnus-summary-cancel-article}). Your article will be
+canceled---machines all over the world will be deleting your article.
+
+Be aware, however, that not all sites honor cancels, so your article may
+live on here and there, while most sites will delete the article in
+question.
+
+If you discover that you have made some mistakes and want to do some
+corrections, you can post a @dfn{superseding} article that will replace
+your original article.
+
+@findex gnus-summary-supersede-article
+@kindex S (Summary)
+Go to the original article and press @kbd{S s}
+(@code{gnus-summary-supersede-article}). You will be put in a buffer
+where you can edit the article all you want before sending it off the
+usual way.
+
+The same goes for superseding as for canceling, only more so: Some
+sites do not honor superseding. On those sites, it will appear that you
+have posted almost the same article twice.
+
+If you have just posted the article, and change your mind right away,
+there is a trick you can use to cancel/supersede the article without
+waiting for the article to appear on your site first. You simply return
+to the post buffer (which is called @code{*sent ...*}). There you will
+find the article you just posted, with all the headers intact. Change
+the @code{Message-ID} header to a @code{Cancel} or @code{Supersedes}
+header by substituting one of those words for the word
+@code{Message-ID}. Then just press @kbd{C-c C-c} to send the article as
+you would do normally. The previous article will be
+canceled/superseded.
+
+Just remember, kids: There is no 'c' in 'supersede'.
+
+
+@node Marking Articles
+@section Marking Articles
+@cindex article marking
+@cindex article ticking
+@cindex marks
+
+There are several marks you can set on an article.
+
+You have marks that decide the @dfn{readedness} (whoo, neato-keano
+neologism ohoy!) of the article. Alphabetic marks generally mean
+@dfn{read}, while non-alphabetic characters generally mean @dfn{unread}.
+
+In addition, you also have marks that do not affect readedness.
+
+@menu
+* Unread Articles:: Marks for unread articles.
+* Read Articles:: Marks for read articles.
+* Other Marks:: Marks that do not affect readedness.
+@end menu
+
+@ifinfo
+There's a plethora of commands for manipulating these marks:
+@end ifinfo
+
+@menu
+* Setting Marks:: How to set and remove marks.
+* Setting Process Marks:: How to mark articles for later processing.
+@end menu
+
+
+@node Unread Articles
+@subsection Unread Articles
+
+The following marks mark articles as (kinda) unread, in one form or
+other.
+
+@table @samp
+@item !
+@vindex gnus-ticked-mark
+Marked as ticked (@code{gnus-ticked-mark}).
+
+@dfn{Ticked articles} are articles that will remain visible always. If
+you see an article that you find interesting, or you want to put off
+reading it, or replying to it, until sometime later, you'd typically
+tick it. However, articles can be expired, so if you want to keep an
+article forever, you'll have to make it persistent (@pxref{Persistent
+Articles}).
+
+@item ?
+@vindex gnus-dormant-mark
+Marked as dormant (@code{gnus-dormant-mark}).
+
+@dfn{Dormant articles} will only appear in the summary buffer if there
+are followups to it. If you want to see them even if they don't have
+followups, you can use the @kbd{/ D} command (@pxref{Limiting}).
+
+@item SPACE
+@vindex gnus-unread-mark
+Markes as unread (@code{gnus-unread-mark}).
+
+@dfn{Unread articles} are articles that haven't been read at all yet.
+@end table
+
+
+@node Read Articles
+@subsection Read Articles
+@cindex expirable mark
+
+All the following marks mark articles as read.
+
+@table @samp
+
+@item r
+@vindex gnus-del-mark
+These are articles that the user has marked as read with the @kbd{d}
+command manually, more or less (@code{gnus-del-mark}).
+
+@item R
+@vindex gnus-read-mark
+Articles that have actually been read (@code{gnus-read-mark}).
+
+@item O
+@vindex gnus-ancient-mark
+Articles that were marked as read in previous sessions and are now
+@dfn{old} (@code{gnus-ancient-mark}).
+
+@item K
+@vindex gnus-killed-mark
+Marked as killed (@code{gnus-killed-mark}).
+
+@item X
+@vindex gnus-kill-file-mark
+Marked as killed by kill files (@code{gnus-kill-file-mark}).
+
+@item Y
+@vindex gnus-low-score-mark
+Marked as read by having too low a score (@code{gnus-low-score-mark}).
+
+@item C
+@vindex gnus-catchup-mark
+Marked as read by a catchup (@code{gnus-catchup-mark}).
+
+@item G
+@vindex gnus-canceled-mark
+Canceled article (@code{gnus-canceled-mark})
+
+@item F
+@vindex gnus-souped-mark
+@sc{SOUP}ed article (@code{gnus-souped-mark}). @xref{SOUP}.
+
+@item Q
+@vindex gnus-sparse-mark
+Sparsely reffed article (@code{gnus-sparse-mark}). @xref{Customizing
+Threading}.
+
+@item M
+@vindex gnus-duplicate-mark
+Article marked as read by duplicate suppression
+(@code{gnus-duplicated-mark}). @xref{Duplicate Suppression}.
+
+@end table
+
+All these marks just mean that the article is marked as read, really.
+They are interpreted differently when doing adaptive scoring, though.
+
+One more special mark, though:
+
+@table @samp
+@item E
+@vindex gnus-expirable-mark
+Marked as expirable (@code{gnus-expirable-mark}).
+
+Marking articles as @dfn{expirable} (or have them marked as such
+automatically) doesn't make much sense in normal groups---a user doesn't
+control expiring of news articles, but in mail groups, for instance,
+articles marked as @dfn{expirable} can be deleted by Gnus at
+any time.
+@end table
+
+
+@node Other Marks
+@subsection Other Marks
+@cindex process mark
+@cindex bookmarks
+
+There are some marks that have nothing to do with whether the article is
+read or not.
+
+@itemize @bullet
+
+@item
+You can set a bookmark in the current article. Say you are reading a
+long thesis on cats' urinary tracts, and have to go home for dinner
+before you've finished reading the thesis. You can then set a bookmark
+in the article, and Gnus will jump to this bookmark the next time it
+encounters the article. @xref{Setting Marks}
+
+@item
+@vindex gnus-replied-mark
+All articles that you have replied to or made a followup to (i.e., have
+answered) will be marked with an @samp{A} in the second column
+(@code{gnus-replied-mark}).
+
+@item
+@vindex gnus-cached-mark
+Articles stored in the article cache will be marked with an @samp{*} in
+the second column (@code{gnus-cached-mark}). @xref{Article Caching}
+
+@item
+@vindex gnus-saved-mark
+Articles ``saved'' (in some manner or other; not necessarily
+religiously) are marked with an @samp{S} in the second column
+(@code{gnus-saved-mark}).
+
+@item
+@vindex gnus-not-empty-thread-mark
+@vindex gnus-empty-thread-mark
+If the @samp{%e} spec is used, the presence of threads or not will be
+marked with @code{gnus-not-empty-thread-mark} and
+@code{gnus-empty-thread-mark} in the third column, respectively.
+
+@item
+@vindex gnus-process-mark
+Finally we have the @dfn{process mark} (@code{gnus-process-mark}). A
+variety of commands react to the presence of the process mark. For
+instance, @kbd{X u} (@code{gnus-uu-decode-uu}) will uudecode and view
+all articles that have been marked with the process mark. Articles
+marked with the process mark have a @samp{#} in the second column.
+
+@end itemize
+
+You might have noticed that most of these ``non-readedness'' marks
+appear in the second column by default. So if you have a cached, saved,
+replied article that you have process-marked, what will that look like?
+
+Nothing much. The precedence rules go as follows: process -> cache ->
+replied -> saved. So if the article is in the cache and is replied,
+you'll only see the cache mark and not the replied mark.
+
+
+@node Setting Marks
+@subsection Setting Marks
+@cindex setting marks
+
+All the marking commands understand the numeric prefix.
+
+@table @kbd
+@item M c
+@itemx M-u
+@kindex M c (Summary)
+@kindex M-u (Summary)
+@findex gnus-summary-clear-mark-forward
+@cindex mark as unread
+Clear all readedness-marks from the current article
+(@code{gnus-summary-clear-mark-forward}). In other words, mark the
+article as unread.
+
+@item M t
+@itemx !
+@kindex ! (Summary)
+@kindex M t (Summary)
+@findex gnus-summary-tick-article-forward
+Tick the current article (@code{gnus-summary-tick-article-forward}).
+@xref{Article Caching}
+
+@item M ?
+@itemx ?
+@kindex ? (Summary)
+@kindex M ? (Summary)
+@findex gnus-summary-mark-as-dormant
+Mark the current article as dormant
+(@code{gnus-summary-mark-as-dormant}). @xref{Article Caching}
+
+@item M d
+@itemx d
+@kindex M d (Summary)
+@kindex d (Summary)
+@findex gnus-summary-mark-as-read-forward
+Mark the current article as read
+(@code{gnus-summary-mark-as-read-forward}).
+
+@item D
+@kindex D (Summary)
+@findex gnus-summary-mark-as-read-backward
+Mark the current article as read and move point to the previous line
+(@code{gnus-summary-mark-as-read-backward}).
+
+@item M k
+@itemx k
+@kindex k (Summary)
+@kindex M k (Summary)
+@findex gnus-summary-kill-same-subject-and-select
+Mark all articles that have the same subject as the current one as read,
+and then select the next unread article
+(@code{gnus-summary-kill-same-subject-and-select}).
+
+@item M K
+@itemx C-k
+@kindex M K (Summary)
+@kindex C-k (Summary)
+@findex gnus-summary-kill-same-subject
+Mark all articles that have the same subject as the current one as read
+(@code{gnus-summary-kill-same-subject}).
+
+@item M C
+@kindex M C (Summary)
+@findex gnus-summary-catchup
+@c @icon{gnus-summary-catchup}
+Mark all unread articles as read (@code{gnus-summary-catchup}).
+
+@item M C-c
+@kindex M C-c (Summary)
+@findex gnus-summary-catchup-all
+Mark all articles in the group as read---even the ticked and dormant
+articles (@code{gnus-summary-catchup-all}).
+
+@item M H
+@kindex M H (Summary)
+@findex gnus-summary-catchup-to-here
+Catchup the current group to point
+(@code{gnus-summary-catchup-to-here}).
+
+@item C-w
+@kindex C-w (Summary)
+@findex gnus-summary-mark-region-as-read
+Mark all articles between point and mark as read
+(@code{gnus-summary-mark-region-as-read}).
+
+@item M V k
+@kindex M V k (Summary)
+@findex gnus-summary-kill-below
+Kill all articles with scores below the default score (or below the
+numeric prefix) (@code{gnus-summary-kill-below}).
+
+@item M e
+@itemx E
+@kindex M e (Summary)
+@kindex E (Summary)
+@findex gnus-summary-mark-as-expirable
+Mark the current article as expirable
+(@code{gnus-summary-mark-as-expirable}).
+
+@item M b
+@kindex M b (Summary)
+@findex gnus-summary-set-bookmark
+Set a bookmark in the current article
+(@code{gnus-summary-set-bookmark}).
+
+@item M B
+@kindex M B (Summary)
+@findex gnus-summary-remove-bookmark
+Remove the bookmark from the current article
+(@code{gnus-summary-remove-bookmark}).
+
+@item M V c
+@kindex M V c (Summary)
+@findex gnus-summary-clear-above
+Clear all marks from articles with scores over the default score (or
+over the numeric prefix) (@code{gnus-summary-clear-above}).
+
+@item M V u
+@kindex M V u (Summary)
+@findex gnus-summary-tick-above
+Tick all articles with scores over the default score (or over the
+numeric prefix) (@code{gnus-summary-tick-above}).
+
+@item M V m
+@kindex M V m (Summary)
+@findex gnus-summary-mark-above
+Prompt for a mark, and mark all articles with scores over the default
+score (or over the numeric prefix) with this mark
+(@code{gnus-summary-clear-above}).
+@end table
+
+@vindex gnus-summary-goto-unread
+The @code{gnus-summary-goto-unread} variable controls what action should
+be taken after setting a mark. If non-@code{nil}, point will move to
+the next/previous unread article. If @code{nil}, point will just move
+one line up or down. As a special case, if this variable is
+@code{never}, all the marking commands as well as other commands (like
+@kbd{SPACE}) will move to the next article, whether it is unread or not.
+The default is @code{t}.
+
+
+@node Setting Process Marks
+@subsection Setting Process Marks
+@cindex setting process marks
+
+@table @kbd
+
+@item M P p
+@itemx #
+@kindex # (Summary)
+@kindex M P p (Summary)
+@findex gnus-summary-mark-as-processable
+Mark the current article with the process mark
+(@code{gnus-summary-mark-as-processable}).
+@findex gnus-summary-unmark-as-processable
+
+@item M P u
+@itemx M-#
+@kindex M P u (Summary)
+@kindex M-# (Summary)
+Remove the process mark, if any, from the current article
+(@code{gnus-summary-unmark-as-processable}).
+
+@item M P U
+@kindex M P U (Summary)
+@findex gnus-summary-unmark-all-processable
+Remove the process mark from all articles
+(@code{gnus-summary-unmark-all-processable}).
+
+@item M P i
+@kindex M P i (Summary)
+@findex gnus-uu-invert-processable
+Invert the list of process marked articles
+(@code{gnus-uu-invert-processable}).
+
+@item M P R
+@kindex M P R (Summary)
+@findex gnus-uu-mark-by-regexp
+Mark articles by a regular expression (@code{gnus-uu-mark-by-regexp}).
+
+@item M P r
+@kindex M P r (Summary)
+@findex gnus-uu-mark-region
+Mark articles in region (@code{gnus-uu-mark-region}).
+
+@item M P t
+@kindex M P t (Summary)
+@findex gnus-uu-mark-thread
+Mark all articles in the current (sub)thread
+(@code{gnus-uu-mark-thread}).
+
+@item M P T
+@kindex M P T (Summary)
+@findex gnus-uu-unmark-thread
+Unmark all articles in the current (sub)thread
+(@code{gnus-uu-unmark-thread}).
+
+@item M P v
+@kindex M P v (Summary)
+@findex gnus-uu-mark-over
+Mark all articles that have a score above the prefix argument
+(@code{gnus-uu-mark-over}).
+
+@item M P s
+@kindex M P s (Summary)
+@findex gnus-uu-mark-series
+Mark all articles in the current series (@code{gnus-uu-mark-series}).
+
+@item M P S
+@kindex M P S (Summary)
+@findex gnus-uu-mark-sparse
+Mark all series that have already had some articles marked
+(@code{gnus-uu-mark-sparse}).
+
+@item M P a
+@kindex M P a (Summary)
+@findex gnus-uu-mark-all
+Mark all articles in series order (@code{gnus-uu-mark-series}).
+
+@item M P b
+@kindex M P b (Summary)
+@findex gnus-uu-mark-buffer
+Mark all articles in the buffer in the order they appear
+(@code{gnus-uu-mark-buffer}).
+
+@item M P k
+@kindex M P k (Summary)
+@findex gnus-summary-kill-process-mark
+Push the current process mark set onto the stack and unmark all articles
+(@code{gnus-summary-kill-process-mark}).
+
+@item M P y
+@kindex M P y (Summary)
+@findex gnus-summary-yank-process-mark
+Pop the previous process mark set from the stack and restore it
+(@code{gnus-summary-yank-process-mark}).
+
+@item M P w
+@kindex M P w (Summary)
+@findex gnus-summary-save-process-mark
+Push the current process mark set onto the stack
+(@code{gnus-summary-save-process-mark}).
+
+@end table
+
+
+@node Limiting
+@section Limiting
+@cindex limiting
+
+It can be convenient to limit the summary buffer to just show some
+subset of the articles currently in the group. The effect most limit
+commands have is to remove a few (or many) articles from the summary
+buffer.
+
+@table @kbd
+
+@item / /
+@itemx / s
+@kindex / / (Summary)
+@findex gnus-summary-limit-to-subject
+Limit the summary buffer to articles that match some subject
+(@code{gnus-summary-limit-to-subject}).
+
+@item / a
+@kindex / a (Summary)
+@findex gnus-summary-limit-to-author
+Limit the summary buffer to articles that match some author
+(@code{gnus-summary-limit-to-author}).
+
+@item / u
+@itemx x
+@kindex / u (Summary)
+@kindex x (Summary)
+@findex gnus-summary-limit-to-unread
+Limit the summary buffer to articles not marked as read
+(@code{gnus-summary-limit-to-unread}). If given a prefix, limit the
+buffer to articles strictly unread. This means that ticked and
+dormant articles will also be excluded.
+
+@item / m
+@kindex / m (Summary)
+@findex gnus-summary-limit-to-marks
+Ask for a mark and then limit to all articles that have not been marked
+with that mark (@code{gnus-summary-limit-to-marks}).
+
+@item / t
+@kindex / t (Summary)
+@findex gnus-summary-limit-to-age
+Ask for a number and then limit the summary buffer to articles older than (or equal to) that number of days
+(@code{gnus-summary-limit-to-marks}). If given a prefix, limit to
+articles younger than that number of days.
+
+@item / n
+@kindex / n (Summary)
+@findex gnus-summary-limit-to-articles
+Limit the summary buffer to the current article
+(@code{gnus-summary-limit-to-articles}). Uses the process/prefix
+convention (@pxref{Process/Prefix}).
+
+@item / w
+@kindex / w (Summary)
+@findex gnus-summary-pop-limit
+Pop the previous limit off the stack and restore it
+(@code{gnus-summary-pop-limit}). If given a prefix, pop all limits off
+the stack.
+
+@item / v
+@kindex / v (Summary)
+@findex gnus-summary-limit-to-score
+Limit the summary buffer to articles that have a score at or above some
+score (@code{gnus-summary-limit-to-score}).
+
+@item / E
+@itemx M S
+@kindex M S (Summary)
+@kindex / E (Summary)
+@findex gnus-summary-limit-include-expunged
+Display all expunged articles
+(@code{gnus-summary-limit-include-expunged}).
+
+@item / D
+@kindex / D (Summary)
+@findex gnus-summary-limit-include-dormant
+Display all dormant articles (@code{gnus-summary-limit-include-dormant}).
+
+@item / d
+@kindex / d (Summary)
+@findex gnus-summary-limit-exclude-dormant
+Hide all dormant articles (@code{gnus-summary-limit-exclude-dormant}).
+
+@item / T
+@kindex / T (Summary)
+@findex gnus-summary-limit-include-thread
+Include all the articles in the current thread.
+
+@item / c
+@kindex / c (Summary)
+@findex gnus-summary-limit-exclude-childless-dormant
+Hide all dormant articles that have no children
+(@code{gnus-summary-limit-exclude-childless-dormant}).
+
+@item / C
+@kindex / C (Summary)
+@findex gnus-summary-limit-mark-excluded-as-read
+Mark all excluded unread articles as read
+(@code{gnus-summary-limit-mark-excluded-as-read}). If given a prefix,
+also mark excluded ticked and dormant articles as read.
+
+@end table
+
+
+@node Threading
+@section Threading
+@cindex threading
+@cindex article threading
+
+Gnus threads articles by default. @dfn{To thread} is to put responses
+to articles directly after the articles they respond to---in a
+hierarchical fashion.
+
+Threading is done by looking at the @code{References} headers of the
+articles. In a perfect world, this would be enough to build pretty
+trees, but unfortunately, the @code{References} header is often broken
+or simply missing. Weird news propagration excarcerbates the problem,
+so one has to employ other heuristics to get pleasing results. A
+plethora of approaches exists, as detailed in horrible detail in
+@pxref{Customizing Threading}.
+
+First, a quick overview of the concepts:
+
+@table @dfn
+@item root
+The top-most article in a thread; the first article in the thread.
+
+@item thread
+A tree-like article structure.
+
+@item sub-thread
+A small(er) section of this tree-like structure.
+
+@item loose threads
+Threads often lose their roots due to article expiry, or due to the root
+already having been read in a previous session, and not displayed in the
+summary buffer. We then typicall have many sub-threads that really
+belong to one thread, but are without connecting roots. These are
+called loose threads.
+
+@item thread gathering
+An attempt to gather loose threads into bigger threads.
+
+@item sparse threads
+A thread where the missing articles have been ``guessed'' at, and are
+displayed as empty lines in the summary buffer.
+
+@end table
+
+
+@menu
+* Customizing Threading:: Variables you can change to affect the threading.
+* Thread Commands:: Thread based commands in the summary buffer.
+@end menu
+
+
+@node Customizing Threading
+@subsection Customizing Threading
+@cindex customizing threading
+
+@menu
+* Loose Threads:: How Gnus gathers loose threads into bigger threads.
+* Filling In Threads:: Making the threads displayed look fuller.
+* More Threading:: Even more variables for fiddling with threads.
+* Low-Level Threading:: You thought it was over... but you were wrong!
+@end menu
+
+
+@node Loose Threads
+@subsubsection Loose Threads
+@cindex <
+@cindex >
+@cindex loose threads
+
+@table @code
+@item gnus-summary-make-false-root
+@vindex gnus-summary-make-false-root
+If non-@code{nil}, Gnus will gather all loose subtrees into one big tree
+and create a dummy root at the top. (Wait a minute. Root at the top?
+Yup.) Loose subtrees occur when the real root has expired, or you've
+read or killed the root in a previous session.
+
+When there is no real root of a thread, Gnus will have to fudge
+something. This variable says what fudging method Gnus should use.
+There are four possible values:
+
+@iftex
+@iflatex
+\gnusfigure{The Summary Buffer}{390}{
+\put(0,0){\epsfig{figure=tmp/summary-adopt.ps,width=7.5cm}}
+\put(445,0){\makebox(0,0)[br]{\epsfig{figure=tmp/summary-empty.ps,width=7.5cm}}}
+\put(0,400){\makebox(0,0)[tl]{\epsfig{figure=tmp/summary-none.ps,width=7.5cm}}}
+\put(445,400){\makebox(0,0)[tr]{\epsfig{figure=tmp/summary-dummy.ps,width=7.5cm}}}
+}
+@end iflatex
+@end iftex
+
+@cindex adopting articles
+
+@table @code
+
+@item adopt
+Gnus will make the first of the orphaned articles the parent. This
+parent will adopt all the other articles. The adopted articles will be
+marked as such by pointy brackets (@samp{<>}) instead of the standard
+square brackets (@samp{[]}). This is the default method.
+
+@item dummy
+@vindex gnus-summary-dummy-line-format
+Gnus will create a dummy summary line that will pretend to be the
+parent. This dummy line does not correspond to any real article, so
+selecting it will just select the first real article after the dummy
+article. @code{gnus-summary-dummy-line-format} is used to specify the
+format of the dummy roots. It accepts only one format spec: @samp{S},
+which is the subject of the article. @xref{Formatting Variables}.
+
+@item empty
+Gnus won't actually make any article the parent, but simply leave the
+subject field of all orphans except the first empty. (Actually, it will
+use @code{gnus-summary-same-subject} as the subject (@pxref{Summary
+Buffer Format}).)
+
+@item none
+Don't make any article parent at all. Just gather the threads and
+display them after one another.
+
+@item nil
+Don't gather loose threads.
+@end table
+
+@item gnus-summary-gather-subject-limit
+@vindex gnus-summary-gather-subject-limit
+Loose threads are gathered by comparing subjects of articles. If this
+variable is @code{nil}, Gnus requires an exact match between the
+subjects of the loose threads before gathering them into one big
+super-thread. This might be too strict a requirement, what with the
+presence of stupid newsreaders that chop off long subject lines. If
+you think so, set this variable to, say, 20 to require that only the
+first 20 characters of the subjects have to match. If you set this
+variable to a really low number, you'll find that Gnus will gather
+everything in sight into one thread, which isn't very helpful.
+
+@cindex fuzzy article gathering
+If you set this variable to the special value @code{fuzzy}, Gnus will
+use a fuzzy string comparison algorithm on the subjects (@pxref{Fuzzy
+Matching}).
+
+@item gnus-simplify-subject-fuzzy-regexp
+@vindex gnus-simplify-subject-fuzzy-regexp
+This can either be a regular expression or list of regular expressions
+that match strings that will be removed from subjects if fuzzy subject
+simplification is used.
+
+@item gnus-simplify-ignored-prefixes
+@vindex gnus-simplify-ignored-prefixes
+If you set @code{gnus-summary-gather-subject-limit} to something as low
+as 10, you might consider setting this variable to something sensible:
+
+@c Written by Michael Ernst <mernst@cs.rice.edu>
+@lisp
+(setq gnus-simplify-ignored-prefixes
+ (concat
+ "\\`\\[?\\("
+ (mapconcat
+ 'identity
+ '("looking"
+ "wanted" "followup" "summary\\( of\\)?"
+ "help" "query" "problem" "question"
+ "answer" "reference" "announce"
+ "How can I" "How to" "Comparison of"
+ ;; ...
+ )
+ "\\|")
+ "\\)\\s *\\("
+ (mapconcat 'identity
+ '("for" "for reference" "with" "about")
+ "\\|")
+ "\\)?\\]?:?[ \t]*"))
+@end lisp
+
+All words that match this regexp will be removed before comparing two
+subjects.
+
+@item gnus-simplify-subject-functions
+@vindex gnus-simplify-subject-functions
+If non-@code{nil}, this variable overrides
+@code{gnus-summary-gather-subject-limit}. This variable should be a
+list of functions to apply to the @code{Subject} string iteratively to
+arrive at the simplified version of the string.
+
+Useful functions to put in this list include:
+
+@table @code
+@item gnus-simplify-subject-re
+@findex gnus-simplify-subject-re
+Strip the leading @samp{Re:}.
+
+@item gnus-simplify-subject-fuzzy
+@findex gnus-simplify-subject-fuzzy
+Simplify fuzzily.
+
+@item gnus-simplify-whitespace
+@findex gnus-simplify-whitespace
+Remove excessive whitespace.
+@end table
+
+You may also write your own functions, of course.
+
+
+@item gnus-summary-gather-exclude-subject
+@vindex gnus-summary-gather-exclude-subject
+Since loose thread gathering is done on subjects only, that might lead
+to many false hits, especially with certain common subjects like
+@samp{} and @samp{(none)}. To make the situation slightly better,
+you can use the regexp @code{gnus-summary-gather-exclude-subject} to say
+what subjects should be excluded from the gathering process.@*
+The default is @samp{^ *$\\|^(none)$}.
+
+@item gnus-summary-thread-gathering-function
+@vindex gnus-summary-thread-gathering-function
+Gnus gathers threads by looking at @code{Subject} headers. This means
+that totally unrelated articles may end up in the same ``thread'', which
+is confusing. An alternate approach is to look at all the
+@code{Message-ID}s in all the @code{References} headers to find matches.
+This will ensure that no gathered threads ever include unrelated
+articles, but it also means that people who have posted with broken
+newsreaders won't be gathered properly. The choice is yours---plague or
+cholera:
+
+@table @code
+@item gnus-gather-threads-by-subject
+@findex gnus-gather-threads-by-subject
+This function is the default gathering function and looks at
+@code{Subject}s exclusively.
+
+@item gnus-gather-threads-by-references
+@findex gnus-gather-threads-by-references
+This function looks at @code{References} headers exclusively.
+@end table
+
+If you want to test gathering by @code{References}, you could say
+something like:
+
+@lisp
+(setq gnus-summary-thread-gathering-function
+ 'gnus-gather-threads-by-references)
+@end lisp
+
+@end table
+
+
+@node Filling In Threads
+@subsubsection Filling In Threads
+
+@table @code
+@item gnus-fetch-old-headers
+@vindex gnus-fetch-old-headers
+If non-@code{nil}, Gnus will attempt to build old threads by fetching
+more old headers---headers to articles marked as read. If you
+would like to display as few summary lines as possible, but still
+connect as many loose threads as possible, you should set this variable
+to @code{some} or a number. If you set it to a number, no more than
+that number of extra old headers will be fetched. In either case,
+fetching old headers only works if the backend you are using carries
+overview files---this would normally be @code{nntp}, @code{nnspool} and
+@code{nnml}. Also remember that if the root of the thread has been
+expired by the server, there's not much Gnus can do about that.
+
+This variable can also be set to @code{invisible}. This won't have any
+visible effects, but is useful if you use the @kbd{A T} command a lot
+(@pxref{Finding the Parent}).
+
+@item gnus-build-sparse-threads
+@vindex gnus-build-sparse-threads
+Fetching old headers can be slow. A low-rent similar effect can be
+gotten by setting this variable to @code{some}. Gnus will then look at
+the complete @code{References} headers of all articles and try to string
+together articles that belong in the same thread. This will leave
+@dfn{gaps} in the threading display where Gnus guesses that an article
+is missing from the thread. (These gaps appear like normal summary
+lines. If you select a gap, Gnus will try to fetch the article in
+question.) If this variable is @code{t}, Gnus will display all these
+``gaps'' without regard for whether they are useful for completing the
+thread or not. Finally, if this variable is @code{more}, Gnus won't cut
+off sparse leaf nodes that don't lead anywhere. This variable is
+@code{nil} by default.
+
+@end table
+
+
+@node More Threading
+@subsubsection More Threading
+
+@table @code
+@item gnus-show-threads
+@vindex gnus-show-threads
+If this variable is @code{nil}, no threading will be done, and all of
+the rest of the variables here will have no effect. Turning threading
+off will speed group selection up a bit, but it is sure to make reading
+slower and more awkward.
+
+@item gnus-thread-hide-subtree
+@vindex gnus-thread-hide-subtree
+If non-@code{nil}, all threads will be hidden when the summary buffer is
+generated.
+
+@item gnus-thread-expunge-below
+@vindex gnus-thread-expunge-below
+All threads that have a total score (as defined by
+@code{gnus-thread-score-function}) less than this number will be
+expunged. This variable is @code{nil} by default, which means that no
+threads are expunged.
+
+@item gnus-thread-hide-killed
+@vindex gnus-thread-hide-killed
+if you kill a thread and this variable is non-@code{nil}, the subtree
+will be hidden.
+
+@item gnus-thread-ignore-subject
+@vindex gnus-thread-ignore-subject
+Sometimes somebody changes the subject in the middle of a thread. If
+this variable is non-@code{nil}, the subject change is ignored. If it
+is @code{nil}, which is the default, a change in the subject will result
+in a new thread.
+
+@item gnus-thread-indent-level
+@vindex gnus-thread-indent-level
+This is a number that says how much each sub-thread should be indented.
+The default is 4.
+
+@end table
+
+
+@node Low-Level Threading
+@subsubsection Low-Level Threading
+
+@table @code
+
+@item gnus-parse-headers-hook
+@vindex gnus-parse-headers-hook
+Hook run before parsing any headers. The default value is
+@code{(gnus-decode-rfc1522)}, which means that QPized headers will be
+slightly decoded in a hackish way. This is likely to change in the
+future when Gnus becomes @sc{MIME}ified.
+
+@item gnus-alter-header-function
+@vindex gnus-alter-header-function
+If non-@code{nil}, this function will be called to allow alteration of
+article header structures. The function is called with one parameter,
+the article header vector, which it may alter in any way. For instance,
+if you have a mail-to-news gateway which alters the @code{Message-ID}s
+in systematic ways (by adding prefixes and such), you can use this
+variable to un-scramble the @code{Message-ID}s so that they are more
+meaningful. Here's one example:
+
+@lisp
+(setq gnus-alter-header-function 'my-alter-message-id)
+
+(defun my-alter-message-id (header)
+ (let ((id (mail-header-id header)))
+ (when (string-match
+ "\\(<[^<>@@]*\\)\\.?cygnus\\..*@@\\([^<>@@]*>\\)" id)
+ (mail-header-set-id
+ (concat (match-string 1 id) "@@" (match-string 2 id))
+ header))))
+@end lisp
+
+@end table
+
+
+@node Thread Commands
+@subsection Thread Commands
+@cindex thread commands
+
+@table @kbd
+
+@item T k
+@itemx M-C-k
+@kindex T k (Summary)
+@kindex M-C-k (Summary)
+@findex gnus-summary-kill-thread
+Mark all articles in the current (sub-)thread as read
+(@code{gnus-summary-kill-thread}). If the prefix argument is positive,
+remove all marks instead. If the prefix argument is negative, tick
+articles instead.
+
+@item T l
+@itemx M-C-l
+@kindex T l (Summary)
+@kindex M-C-l (Summary)
+@findex gnus-summary-lower-thread
+Lower the score of the current (sub-)thread
+(@code{gnus-summary-lower-thread}).
+
+@item T i
+@kindex T i (Summary)
+@findex gnus-summary-raise-thread
+Increase the score of the current (sub-)thread
+(@code{gnus-summary-raise-thread}).
+
+@item T #
+@kindex T # (Summary)
+@findex gnus-uu-mark-thread
+Set the process mark on the current (sub-)thread
+(@code{gnus-uu-mark-thread}).
+
+@item T M-#
+@kindex T M-# (Summary)
+@findex gnus-uu-unmark-thread
+Remove the process mark from the current (sub-)thread
+(@code{gnus-uu-unmark-thread}).
+
+@item T T
+@kindex T T (Summary)
+@findex gnus-summary-toggle-threads
+Toggle threading (@code{gnus-summary-toggle-threads}).
+
+@item T s
+@kindex T s (Summary)
+@findex gnus-summary-show-thread
+Expose the (sub-)thread hidden under the current article, if any
+(@code{gnus-summary-show-thread}).
+
+@item T h
+@kindex T h (Summary)
+@findex gnus-summary-hide-thread
+Hide the current (sub-)thread (@code{gnus-summary-hide-thread}).
+
+@item T S
+@kindex T S (Summary)
+@findex gnus-summary-show-all-threads
+Expose all hidden threads (@code{gnus-summary-show-all-threads}).
+
+@item T H
+@kindex T H (Summary)
+@findex gnus-summary-hide-all-threads
+Hide all threads (@code{gnus-summary-hide-all-threads}).
+
+@item T t
+@kindex T t (Summary)
+@findex gnus-summary-rethread-current
+Re-thread the current article's thread
+(@code{gnus-summary-rethread-current}). This works even when the
+summary buffer is otherwise unthreaded.
+
+@item T ^
+@kindex T ^ (Summary)
+@findex gnus-summary-reparent-thread
+Make the current article the child of the marked (or previous) article
+(@code{gnus-summary-reparent-thread}).
+
+@end table
+
+The following commands are thread movement commands. They all
+understand the numeric prefix.
+
+@table @kbd
+
+@item T n
+@kindex T n (Summary)
+@findex gnus-summary-next-thread
+Go to the next thread (@code{gnus-summary-next-thread}).
+
+@item T p
+@kindex T p (Summary)
+@findex gnus-summary-prev-thread
+Go to the previous thread (@code{gnus-summary-prev-thread}).
+
+@item T d
+@kindex T d (Summary)
+@findex gnus-summary-down-thread
+Descend the thread (@code{gnus-summary-down-thread}).
+
+@item T u
+@kindex T u (Summary)
+@findex gnus-summary-up-thread
+Ascend the thread (@code{gnus-summary-up-thread}).
+
+@item T o
+@kindex T o (Summary)
+@findex gnus-summary-top-thread
+Go to the top of the thread (@code{gnus-summary-top-thread}).
+@end table
+
+@vindex gnus-thread-operation-ignore-subject
+If you ignore subject while threading, you'll naturally end up with
+threads that have several different subjects in them. If you then issue
+a command like `T k' (@code{gnus-summary-kill-thread}) you might not
+wish to kill the entire thread, but just those parts of the thread that
+have the same subject as the current article. If you like this idea,
+you can fiddle with @code{gnus-thread-operation-ignore-subject}. If it
+is non-@code{nil} (which it is by default), subjects will be ignored
+when doing thread commands. If this variable is @code{nil}, articles in
+the same thread with different subjects will not be included in the
+operation in question. If this variable is @code{fuzzy}, only articles
+that have subjects fuzzily equal will be included (@pxref{Fuzzy
+Matching}).
+
+
+@node Sorting
+@section Sorting
+
+@findex gnus-thread-sort-by-total-score
+@findex gnus-thread-sort-by-date
+@findex gnus-thread-sort-by-score
+@findex gnus-thread-sort-by-subject
+@findex gnus-thread-sort-by-author
+@findex gnus-thread-sort-by-number
+@vindex gnus-thread-sort-functions
+If you are using a threaded summary display, you can sort the threads by
+setting @code{gnus-thread-sort-functions}, which is a list of functions.
+By default, sorting is done on article numbers. Ready-made sorting
+predicate functions include @code{gnus-thread-sort-by-number},
+@code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject},
+@code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, and
+@code{gnus-thread-sort-by-total-score}.
+
+Each function takes two threads and returns non-@code{nil} if the first
+thread should be sorted before the other. Note that sorting really is
+normally done by looking only at the roots of each thread. If you use
+more than one function, the primary sort key should be the last function
+in the list. You should probably always include
+@code{gnus-thread-sort-by-number} in the list of sorting
+functions---preferably first. This will ensure that threads that are
+equal with respect to the other sort criteria will be displayed in
+ascending article order.
+
+If you would like to sort by score, then by subject, and finally by
+number, you could do something like:
+
+@lisp
+(setq gnus-thread-sort-functions
+ '(gnus-thread-sort-by-number
+ gnus-thread-sort-by-subject
+ gnus-thread-sort-by-total-score))
+@end lisp
+
+The threads that have highest score will be displayed first in the
+summary buffer. When threads have the same score, they will be sorted
+alphabetically. The threads that have the same score and the same
+subject will be sorted by number, which is (normally) the sequence in
+which the articles arrived.
+
+If you want to sort by score and then reverse arrival order, you could
+say something like:
+
+@lisp
+(setq gnus-thread-sort-functions
+ '((lambda (t1 t2)
+ (not (gnus-thread-sort-by-number t2 t1)))
+ gnus-thread-sort-by-score))
+@end lisp
+
+@vindex gnus-thread-score-function
+The function in the @code{gnus-thread-score-function} variable (default
+@code{+}) is used for calculating the total score of a thread. Useful
+functions might be @code{max}, @code{min}, or squared means, or whatever
+tickles your fancy.
+
+@findex gnus-article-sort-functions
+@findex gnus-article-sort-by-date
+@findex gnus-article-sort-by-score
+@findex gnus-article-sort-by-subject
+@findex gnus-article-sort-by-author
+@findex gnus-article-sort-by-number
+If you are using an unthreaded display for some strange reason or other,
+you have to fiddle with the @code{gnus-article-sort-functions} variable.
+It is very similar to the @code{gnus-thread-sort-functions}, except that
+it uses slightly different functions for article comparison. Available
+sorting predicate functions are @code{gnus-article-sort-by-number},
+@code{gnus-article-sort-by-author}, @code{gnus-article-sort-by-subject},
+@code{gnus-article-sort-by-date}, and @code{gnus-article-sort-by-score}.
+
+If you want to sort an unthreaded summary display by subject, you could
+say something like:
+
+@lisp
+(setq gnus-article-sort-functions
+ '(gnus-article-sort-by-number
+ gnus-article-sort-by-subject))
+@end lisp
+
+
+
+@node Asynchronous Fetching
+@section Asynchronous Article Fetching
+@cindex asynchronous article fetching
+@cindex article pre-fetch
+@cindex pre-fetch
+
+If you read your news from an @sc{nntp} server that's far away, the
+network latencies may make reading articles a chore. You have to wait
+for a while after pressing @kbd{n} to go to the next article before the
+article appears. Why can't Gnus just go ahead and fetch the article
+while you are reading the previous one? Why not, indeed.
+
+First, some caveats. There are some pitfalls to using asynchronous
+article fetching, especially the way Gnus does it.
+
+Let's say you are reading article 1, which is short, and article 2 is
+quite long, and you are not interested in reading that. Gnus does not
+know this, so it goes ahead and fetches article 2. You decide to read
+article 3, but since Gnus is in the process of fetching article 2, the
+connection is blocked.
+
+To avoid these situations, Gnus will open two (count 'em two)
+connections to the server. Some people may think this isn't a very nice
+thing to do, but I don't see any real alternatives. Setting up that
+extra connection takes some time, so Gnus startup will be slower.
+
+Gnus will fetch more articles than you will read. This will mean that
+the link between your machine and the @sc{nntp} server will become more
+loaded than if you didn't use article pre-fetch. The server itself will
+also become more loaded---both with the extra article requests, and the
+extra connection.
+
+Ok, so now you know that you shouldn't really use this thing... unless
+you really want to.
+
+@vindex gnus-asynchronous
+Here's how: Set @code{gnus-asynchronous} to @code{t}. The rest should
+happen automatically.
+
+@vindex gnus-use-article-prefetch
+You can control how many articles are to be pre-fetched by setting
+@code{gnus-use-article-prefetch}. This is 30 by default, which means
+that when you read an article in the group, the backend will pre-fetch
+the next 30 articles. If this variable is @code{t}, the backend will
+pre-fetch all the articles it can without bound. If it is
+@code{nil}, no pre-fetching will be done.
+
+@vindex gnus-async-prefetch-article-p
+@findex gnus-async-read-p
+There are probably some articles that you don't want to pre-fetch---read
+articles, for instance. The @code{gnus-async-prefetch-article-p} variable controls whether an article is to be pre-fetched. This function should
+return non-@code{nil} when the article in question is to be
+pre-fetched. The default is @code{gnus-async-read-p}, which returns
+@code{nil} on read articles. The function is called with an article
+data structure as the only parameter.
+
+If, for instance, you wish to pre-fetch only unread articles shorter than 100 lines, you could say something like:
+
+@lisp
+(defun my-async-short-unread-p (data)
+ "Return non-nil for short, unread articles."
+ (and (gnus-data-unread-p data)
+ (< (mail-header-lines (gnus-data-header data))
+ 100)))
+
+(setq gnus-async-prefetch-article-p 'my-async-short-unread-p)
+@end lisp
+
+These functions will be called many, many times, so they should
+preferably be short and sweet to avoid slowing down Gnus too much.
+It's probably a good idea to byte-compile things like this.
+
+@vindex gnus-prefetched-article-deletion-strategy
+Articles have to be removed from the asynch buffer sooner or later. The
+@code{gnus-prefetched-article-deletion-strategy} says when to remove
+articles. This is a list that may contain the following elements:
+
+@table @code
+@item read
+Remove articles when they are read.
+
+@item exit
+Remove articles when exiting the group.
+@end table
+
+The default value is @code{(read exit)}.
+
+@vindex gnus-use-header-prefetch
+If @code{gnus-use-header-prefetch} is non-@code{nil}, prefetch articles
+from the next group.
+
+
+@node Article Caching
+@section Article Caching
+@cindex article caching
+@cindex caching
+
+If you have an @emph{extremely} slow @sc{nntp} connection, you may
+consider turning article caching on. Each article will then be stored
+locally under your home directory. As you may surmise, this could
+potentially use @emph{huge} amounts of disk space, as well as eat up all
+your inodes so fast it will make your head swim. In vodka.
+
+Used carefully, though, it could be just an easier way to save articles.
+
+@vindex gnus-use-long-file-name
+@vindex gnus-cache-directory
+@vindex gnus-use-cache
+To turn caching on, set @code{gnus-use-cache} to @code{t}. By default,
+all articles ticked or marked as dormant will then be copied
+over to your local cache (@code{gnus-cache-directory}). Whether this
+cache is flat or hierarchal is controlled by the
+@code{gnus-use-long-file-name} variable, as usual.
+
+When re-selecting a ticked or dormant article, it will be fetched from the
+cache instead of from the server. As articles in your cache will never
+expire, this might serve as a method of saving articles while still
+keeping them where they belong. Just mark all articles you want to save
+as dormant, and don't worry.
+
+When an article is marked as read, is it removed from the cache.
+
+@vindex gnus-cache-remove-articles
+@vindex gnus-cache-enter-articles
+The entering/removal of articles from the cache is controlled by the
+@code{gnus-cache-enter-articles} and @code{gnus-cache-remove-articles}
+variables. Both are lists of symbols. The first is @code{(ticked
+dormant)} by default, meaning that ticked and dormant articles will be
+put in the cache. The latter is @code{(read)} by default, meaning that
+articles marked as read are removed from the cache. Possibly
+symbols in these two lists are @code{ticked}, @code{dormant},
+@code{unread} and @code{read}.
+
+@findex gnus-jog-cache
+So where does the massive article-fetching and storing come into the
+picture? The @code{gnus-jog-cache} command will go through all
+subscribed newsgroups, request all unread articles, score them, and
+store them in the cache. You should only ever, ever ever ever, use this
+command if 1) your connection to the @sc{nntp} server is really, really,
+really slow and 2) you have a really, really, really huge disk.
+Seriously. One way to cut down on the number of articles downloaded is
+to score unwanted articles down and have them marked as read. They will
+not then be downloaded by this command.
+
+@vindex gnus-uncacheable-groups
+It is likely that you do not want caching on some groups. For instance,
+if your @code{nnml} mail is located under your home directory, it makes no
+sense to cache it somewhere else under your home directory. Unless you
+feel that it's neat to use twice as much space. To limit the caching,
+you could set the @code{gnus-uncacheable-groups} regexp to
+@samp{^nnml}, for instance. This variable is @code{nil} by
+default.
+
+@findex gnus-cache-generate-nov-databases
+@findex gnus-cache-generate-active
+@vindex gnus-cache-active-file
+The cache stores information on what articles it contains in its active
+file (@code{gnus-cache-active-file}). If this file (or any other parts
+of the cache) becomes all messed up for some reason or other, Gnus
+offers two functions that will try to set things right. @kbd{M-x
+gnus-cache-generate-nov-databases} will (re)build all the @sc{nov}
+files, and @kbd{gnus-cache-generate-active} will (re)generate the active
+file.
+
+
+@node Persistent Articles
+@section Persistent Articles
+@cindex persistent articles
+
+Closely related to article caching, we have @dfn{persistent articles}.
+In fact, it's just a different way of looking at caching, and much more
+useful in my opinion.
+
+Say you're reading a newsgroup, and you happen on to some valuable gem
+that you want to keep and treasure forever. You'd normally just save it
+(using one of the many saving commands) in some file. The problem with
+that is that it's just, well, yucky. Ideally you'd prefer just having
+the article remain in the group where you found it forever; untouched by
+the expiry going on at the news server.
+
+This is what a @dfn{persistent article} is---an article that just won't
+be deleted. It's implemented using the normal cache functions, but
+you use two explicit commands for managing persistent articles:
+
+@table @kbd
+
+@item *
+@kindex * (Summary)
+@findex gnus-cache-enter-article
+Make the current article persistent (@code{gnus-cache-enter-article}).
+
+@item M-*
+@kindex M-* (Summary)
+@findex gnus-cache-remove-article
+Remove the current article from the persistent articles
+(@code{gnus-cache-remove-article}). This will normally delete the
+article.
+@end table
+
+Both these commands understand the process/prefix convention.
+
+To avoid having all ticked articles (and stuff) entered into the cache,
+you should set @code{gnus-use-cache} to @code{passive} if you're just
+interested in persistent articles:
+
+@lisp
+(setq gnus-use-cache 'passive)
+@end lisp
+
+
+@node Article Backlog
+@section Article Backlog
+@cindex backlog
+@cindex article backlog
+
+If you have a slow connection, but the idea of using caching seems
+unappealing to you (and it is, really), you can help the situation some
+by switching on the @dfn{backlog}. This is where Gnus will buffer
+already read articles so that it doesn't have to re-fetch articles
+you've already read. This only helps if you are in the habit of
+re-selecting articles you've recently read, of course. If you never do
+that, turning the backlog on will slow Gnus down a little bit, and
+increase memory usage some.
+
+@vindex gnus-keep-backlog
+If you set @code{gnus-keep-backlog} to a number @var{n}, Gnus will store
+at most @var{n} old articles in a buffer for later re-fetching. If this
+variable is non-@code{nil} and is not a number, Gnus will store
+@emph{all} read articles, which means that your Emacs will grow without
+bound before exploding and taking your machine down with you. I put
+that in there just to keep y'all on your toes.
+
+This variable is @code{nil} by default.
+
+
+@node Saving Articles
+@section Saving Articles
+@cindex saving articles
+
+Gnus can save articles in a number of ways. Below is the documentation
+for saving articles in a fairly straight-forward fashion (i.e., little
+processing of the article is done before it is saved). For a different
+approach (uudecoding, unsharing) you should use @code{gnus-uu}
+(@pxref{Decoding Articles}).
+
+@vindex gnus-save-all-headers
+If @code{gnus-save-all-headers} is non-@code{nil}, Gnus will not delete
+unwanted headers before saving the article.
+
+@vindex gnus-saved-headers
+If the preceding variable is @code{nil}, all headers that match the
+@code{gnus-saved-headers} regexp will be kept, while the rest will be
+deleted before saving.
+
+@table @kbd
+
+@item O o
+@itemx o
+@kindex O o (Summary)
+@kindex o (Summary)
+@findex gnus-summary-save-article
+@c @icon{gnus-summary-save-article}
+Save the current article using the default article saver
+(@code{gnus-summary-save-article}).
+
+@item O m
+@kindex O m (Summary)
+@findex gnus-summary-save-article-mail
+Save the current article in mail format
+(@code{gnus-summary-save-article-mail}).
+
+@item O r
+@kindex O r (Summary)
+@findex gnus-summary-save-article-rmail
+Save the current article in rmail format
+(@code{gnus-summary-save-article-rmail}).
+
+@item O f
+@kindex O f (Summary)
+@findex gnus-summary-save-article-file
+@c @icon{gnus-summary-save-article-file}
+Save the current article in plain file format
+(@code{gnus-summary-save-article-file}).
+
+@item O F
+@kindex O F (Summary)
+@findex gnus-summary-write-article-file
+Write the current article in plain file format, overwriting any previous
+file contents (@code{gnus-summary-write-article-file}).
+
+@item O b
+@kindex O b (Summary)
+@findex gnus-summary-save-article-body-file
+Save the current article body in plain file format
+(@code{gnus-summary-save-article-body-file}).
+
+@item O h
+@kindex O h (Summary)
+@findex gnus-summary-save-article-folder
+Save the current article in mh folder format
+(@code{gnus-summary-save-article-folder}).
+
+@item O v
+@kindex O v (Summary)
+@findex gnus-summary-save-article-vm
+Save the current article in a VM folder
+(@code{gnus-summary-save-article-vm}).
+
+@item O p
+@kindex O p (Summary)
+@findex gnus-summary-pipe-output
+Save the current article in a pipe. Uhm, like, what I mean is---Pipe
+the current article to a process (@code{gnus-summary-pipe-output}).
+@end table
+
+@vindex gnus-prompt-before-saving
+All these commands use the process/prefix convention
+(@pxref{Process/Prefix}). If you save bunches of articles using these
+functions, you might get tired of being prompted for files to save each
+and every article in. The prompting action is controlled by
+the @code{gnus-prompt-before-saving} variable, which is @code{always} by
+default, giving you that excessive prompting action you know and
+loathe. If you set this variable to @code{t} instead, you'll be prompted
+just once for each series of articles you save. If you like to really
+have Gnus do all your thinking for you, you can even set this variable
+to @code{nil}, which means that you will never be prompted for files to
+save articles in. Gnus will simply save all the articles in the default
+files.
+
+
+@vindex gnus-default-article-saver
+You can customize the @code{gnus-default-article-saver} variable to make
+Gnus do what you want it to. You can use any of the four ready-made
+functions below, or you can create your own.
+
+@table @code
+
+@item gnus-summary-save-in-rmail
+@findex gnus-summary-save-in-rmail
+@vindex gnus-rmail-save-name
+@findex gnus-plain-save-name
+This is the default format, @dfn{babyl}. Uses the function in the
+@code{gnus-rmail-save-name} variable to get a file name to save the
+article in. The default is @code{gnus-plain-save-name}.
+
+@item gnus-summary-save-in-mail
+@findex gnus-summary-save-in-mail
+@vindex gnus-mail-save-name
+Save in a Unix mail (mbox) file. Uses the function in the
+@code{gnus-mail-save-name} variable to get a file name to save the
+article in. The default is @code{gnus-plain-save-name}.
+
+@item gnus-summary-save-in-file
+@findex gnus-summary-save-in-file
+@vindex gnus-file-save-name
+@findex gnus-numeric-save-name
+Append the article straight to an ordinary file. Uses the function in
+the @code{gnus-file-save-name} variable to get a file name to save the
+article in. The default is @code{gnus-numeric-save-name}.
+
+@item gnus-summary-save-body-in-file
+@findex gnus-summary-save-body-in-file
+Append the article body to an ordinary file. Uses the function in the
+@code{gnus-file-save-name} variable to get a file name to save the
+article in. The default is @code{gnus-numeric-save-name}.
+
+@item gnus-summary-save-in-folder
+@findex gnus-summary-save-in-folder
+@findex gnus-folder-save-name
+@findex gnus-Folder-save-name
+@vindex gnus-folder-save-name
+@cindex rcvstore
+@cindex MH folders
+Save the article to an MH folder using @code{rcvstore} from the MH
+library. Uses the function in the @code{gnus-folder-save-name} variable
+to get a file name to save the article in. The default is
+@code{gnus-folder-save-name}, but you can also use
+@code{gnus-Folder-save-name}, which creates capitalized names.
+
+@item gnus-summary-save-in-vm
+@findex gnus-summary-save-in-vm
+Save the article in a VM folder. You have to have the VM mail
+reader to use this setting.
+@end table
+
+@vindex gnus-article-save-directory
+All of these functions, except for the last one, will save the article
+in the @code{gnus-article-save-directory}, which is initialized from the
+@code{SAVEDIR} environment variable. This is @file{~/News/} by
+default.
+
+As you can see above, the functions use different functions to find a
+suitable name of a file to save the article in. Below is a list of
+available functions that generate names:
+
+@table @code
+
+@item gnus-Numeric-save-name
+@findex gnus-Numeric-save-name
+File names like @file{~/News/Alt.andrea-dworkin/45}.
+
+@item gnus-numeric-save-name
+@findex gnus-numeric-save-name
+File names like @file{~/News/alt.andrea-dworkin/45}.
+
+@item gnus-Plain-save-name
+@findex gnus-Plain-save-name
+File names like @file{~/News/Alt.andrea-dworkin}.
+
+@item gnus-plain-save-name
+@findex gnus-plain-save-name
+File names like @file{~/News/alt.andrea-dworkin}.
+@end table
+
+@vindex gnus-split-methods
+You can have Gnus suggest where to save articles by plonking a regexp into
+the @code{gnus-split-methods} alist. For instance, if you would like to
+save articles related to Gnus in the file @file{gnus-stuff}, and articles
+related to VM in @code{vm-stuff}, you could set this variable to something
+like:
+
+@lisp
+(("^Subject:.*gnus\\|^Newsgroups:.*gnus" "gnus-stuff")
+ ("^Subject:.*vm\\|^Xref:.*vm" "vm-stuff")
+ (my-choosing-function "../other-dir/my-stuff")
+ ((equal gnus-newsgroup-name "mail.misc") "mail-stuff"))
+@end lisp
+
+We see that this is a list where each element is a list that has two
+elements---the @dfn{match} and the @dfn{file}. The match can either be
+a string (in which case it is used as a regexp to match on the article
+head); it can be a symbol (which will be called as a function with the
+group name as a parameter); or it can be a list (which will be
+@code{eval}ed). If any of these actions have a non-@code{nil} result,
+the @dfn{file} will be used as a default prompt. In addition, the
+result of the operation itself will be used if the function or form
+called returns a string or a list of strings.
+
+You basically end up with a list of file names that might be used when
+saving the current article. (All ``matches'' will be used.) You will
+then be prompted for what you really want to use as a name, with file
+name completion over the results from applying this variable.
+
+This variable is @code{((gnus-article-archive-name))} by default, which
+means that Gnus will look at the articles it saves for an
+@code{Archive-name} line and use that as a suggestion for the file
+name.
+
+Here's an example function to clean up file names somewhat. If you have
+lots of mail groups called things like
+@samp{nnml:mail.whatever}, you may want to chop off the beginning of
+these group names before creating the file name to save to. The
+following will do just that:
+
+@lisp
+(defun my-save-name (group)
+ (when (string-match "^nnml:mail." group)
+ (substring group (match-end 0))))
+
+(setq gnus-split-methods
+ '((gnus-article-archive-name)
+ (my-save-name)))
+@end lisp
+
+
+@vindex gnus-use-long-file-name
+Finally, you have the @code{gnus-use-long-file-name} variable. If it is
+@code{nil}, all the preceding functions will replace all periods
+(@samp{.}) in the group names with slashes (@samp{/})---which means that
+the functions will generate hierarchies of directories instead of having
+all the files in the toplevel directory
+(@file{~/News/alt/andrea-dworkin} instead of
+@file{~/News/alt.andrea-dworkin}.) This variable is @code{t} by default
+on most systems. However, for historical reasons, this is @code{nil} on
+Xenix and usg-unix-v machines by default.
+
+This function also affects kill and score file names. If this variable
+is a list, and the list contains the element @code{not-score}, long file
+names will not be used for score files, if it contains the element
+@code{not-save}, long file names will not be used for saving, and if it
+contains the element @code{not-kill}, long file names will not be used
+for kill files.
+
+If you'd like to save articles in a hierarchy that looks something like
+a spool, you could
+
+@lisp
+(setq gnus-use-long-file-name '(not-save)) ; to get a hierarchy
+(setq gnus-default-article-saver 'gnus-summary-save-in-file) ; no encoding
+@end lisp
+
+Then just save with @kbd{o}. You'd then read this hierarchy with
+ephemeral @code{nneething} groups---@kbd{G D} in the group buffer, and
+the toplevel directory as the argument (@file{~/News/}). Then just walk
+around to the groups/directories with @code{nneething}.
+
+
+@node Decoding Articles
+@section Decoding Articles
+@cindex decoding articles
+
+Sometime users post articles (or series of articles) that have been
+encoded in some way or other. Gnus can decode them for you.
+
+@menu
+* Uuencoded Articles:: Uudecode articles.
+* Shell Archives:: Unshar articles.
+* PostScript Files:: Split PostScript.
+* Other Files:: Plain save and binhex.
+* Decoding Variables:: Variables for a happy decoding.
+* Viewing Files:: You want to look at the result of the decoding?
+@end menu
+
+@cindex series
+@cindex article series
+All these functions use the process/prefix convention
+(@pxref{Process/Prefix}) for finding out what articles to work on, with
+the extension that a ``single article'' means ``a single series''. Gnus
+can find out by itself what articles belong to a series, decode all the
+articles and unpack/view/save the resulting file(s).
+
+Gnus guesses what articles are in the series according to the following
+simplish rule: The subjects must be (nearly) identical, except for the
+last two numbers of the line. (Spaces are largely ignored, however.)
+
+For example: If you choose a subject called @samp{cat.gif (2/3)}, Gnus
+will find all the articles that match the regexp @samp{^cat.gif
+([0-9]+/[0-9]+).*$}.
+
+Subjects that are non-standard, like @samp{cat.gif (2/3) Part 6 of a
+series}, will not be properly recognized by any of the automatic viewing
+commands, and you have to mark the articles manually with @kbd{#}.
+
+
+@node Uuencoded Articles
+@subsection Uuencoded Articles
+@cindex uudecode
+@cindex uuencoded articles
+
+@table @kbd
+
+@item X u
+@kindex X u (Summary)
+@findex gnus-uu-decode-uu
+@c @icon{gnus-uu-decode-uu}
+Uudecodes the current series (@code{gnus-uu-decode-uu}).
+
+@item X U
+@kindex X U (Summary)
+@findex gnus-uu-decode-uu-and-save
+Uudecodes and saves the current series
+(@code{gnus-uu-decode-uu-and-save}).
+
+@item X v u
+@kindex X v u (Summary)
+@findex gnus-uu-decode-uu-view
+Uudecodes and views the current series (@code{gnus-uu-decode-uu-view}).
+
+@item X v U
+@kindex X v U (Summary)
+@findex gnus-uu-decode-uu-and-save-view
+Uudecodes, views and saves the current series
+(@code{gnus-uu-decode-uu-and-save-view}).
+
+@end table
+
+Remember that these all react to the presence of articles marked with
+the process mark. If, for instance, you'd like to decode and save an
+entire newsgroup, you'd typically do @kbd{M P a}
+(@code{gnus-uu-mark-all}) and then @kbd{X U}
+(@code{gnus-uu-decode-uu-and-save}).
+
+All this is very much different from how @code{gnus-uu} worked with
+@sc{gnus 4.1}, where you had explicit keystrokes for everything under
+the sun. This version of @code{gnus-uu} generally assumes that you mark
+articles in some way (@pxref{Setting Process Marks}) and then press
+@kbd{X u}.
+
+@vindex gnus-uu-notify-files
+Note: When trying to decode articles that have names matching
+@code{gnus-uu-notify-files}, which is hard-coded to
+@samp{[Cc][Ii][Nn][Dd][Yy][0-9]+.\\(gif\\|jpg\\)}, @code{gnus-uu} will
+automatically post an article on @samp{comp.unix.wizards} saying that
+you have just viewed the file in question. This feature can't be turned
+off.
+
+
+@node Shell Archives
+@subsection Shell Archives
+@cindex unshar
+@cindex shell archives
+@cindex shared articles
+
+Shell archives (``shar files'') used to be a popular way to distribute
+sources, but it isn't used all that much today. In any case, we have
+some commands to deal with these:
+
+@table @kbd
+
+@item X s
+@kindex X s (Summary)
+@findex gnus-uu-decode-unshar
+Unshars the current series (@code{gnus-uu-decode-unshar}).
+
+@item X S
+@kindex X S (Summary)
+@findex gnus-uu-decode-unshar-and-save
+Unshars and saves the current series (@code{gnus-uu-decode-unshar-and-save}).
+
+@item X v s
+@kindex X v s (Summary)
+@findex gnus-uu-decode-unshar-view
+Unshars and views the current series (@code{gnus-uu-decode-unshar-view}).
+
+@item X v S
+@kindex X v S (Summary)
+@findex gnus-uu-decode-unshar-and-save-view
+Unshars, views and saves the current series
+(@code{gnus-uu-decode-unshar-and-save-view}).
+@end table
+
+
+@node PostScript Files
+@subsection PostScript Files
+@cindex PostScript
+
+@table @kbd
+
+@item X p
+@kindex X p (Summary)
+@findex gnus-uu-decode-postscript
+Unpack the current PostScript series (@code{gnus-uu-decode-postscript}).
+
+@item X P
+@kindex X P (Summary)
+@findex gnus-uu-decode-postscript-and-save
+Unpack and save the current PostScript series
+(@code{gnus-uu-decode-postscript-and-save}).
+
+@item X v p
+@kindex X v p (Summary)
+@findex gnus-uu-decode-postscript-view
+View the current PostScript series
+(@code{gnus-uu-decode-postscript-view}).
+
+@item X v P
+@kindex X v P (Summary)
+@findex gnus-uu-decode-postscript-and-save-view
+View and save the current PostScript series
+(@code{gnus-uu-decode-postscript-and-save-view}).
+@end table
+
+
+@node Other Files
+@subsection Other Files
+
+@table @kbd
+@item X o
+@kindex X o (Summary)
+@findex gnus-uu-decode-save
+Save the current series
+(@code{gnus-uu-decode-save}).
+
+@item X b
+@kindex X b (Summary)
+@findex gnus-uu-decode-binhex
+Unbinhex the current series (@code{gnus-uu-decode-binhex}). This
+doesn't really work yet.
+@end table
+
+
+@node Decoding Variables
+@subsection Decoding Variables
+
+Adjective, not verb.
+
+@menu
+* Rule Variables:: Variables that say how a file is to be viewed.
+* Other Decode Variables:: Other decode variables.
+* Uuencoding and Posting:: Variables for customizing uuencoding.
+@end menu
+
+
+@node Rule Variables
+@subsubsection Rule Variables
+@cindex rule variables
+
+Gnus uses @dfn{rule variables} to decide how to view a file. All these
+variables are of the form
+
+@lisp
+ (list '(regexp1 command2)
+ '(regexp2 command2)
+ ...)
+@end lisp
+
+@table @code
+
+@item gnus-uu-user-view-rules
+@vindex gnus-uu-user-view-rules
+@cindex sox
+This variable is consulted first when viewing files. If you wish to use,
+for instance, @code{sox} to convert an @samp{.au} sound file, you could
+say something like:
+@lisp
+(setq gnus-uu-user-view-rules
+ (list '(\"\\\\.au$\" \"sox %s -t .aiff > /dev/audio\")))
+@end lisp
+
+@item gnus-uu-user-view-rules-end
+@vindex gnus-uu-user-view-rules-end
+This variable is consulted if Gnus couldn't make any matches from the
+user and default view rules.
+
+@item gnus-uu-user-archive-rules
+@vindex gnus-uu-user-archive-rules
+This variable can be used to say what commands should be used to unpack
+archives.
+@end table
+
+
+@node Other Decode Variables
+@subsubsection Other Decode Variables
+
+@table @code
+@vindex gnus-uu-grabbed-file-functions
+
+@item gnus-uu-grabbed-file-functions
+All functions in this list will be called right after each file has been
+successfully decoded---so that you can move or view files right away,
+and don't have to wait for all files to be decoded before you can do
+anything. Ready-made functions you can put in this list are:
+
+@table @code
+
+@item gnus-uu-grab-view
+@findex gnus-uu-grab-view
+View the file.
+
+@item gnus-uu-grab-move
+@findex gnus-uu-grab-move
+Move the file (if you're using a saving function.)
+@end table
+
+@item gnus-uu-be-dangerous
+@vindex gnus-uu-be-dangerous
+Specifies what to do if unusual situations arise during decoding. If
+@code{nil}, be as conservative as possible. If @code{t}, ignore things
+that didn't work, and overwrite existing files. Otherwise, ask each
+time.
+
+@item gnus-uu-ignore-files-by-name
+@vindex gnus-uu-ignore-files-by-name
+Files with name matching this regular expression won't be viewed.
+
+@item gnus-uu-ignore-files-by-type
+@vindex gnus-uu-ignore-files-by-type
+Files with a @sc{mime} type matching this variable won't be viewed.
+Note that Gnus tries to guess what type the file is based on the name.
+@code{gnus-uu} is not a @sc{mime} package (yet), so this is slightly
+kludgey.
+
+@item gnus-uu-tmp-dir
+@vindex gnus-uu-tmp-dir
+Where @code{gnus-uu} does its work.
+
+@item gnus-uu-do-not-unpack-archives
+@vindex gnus-uu-do-not-unpack-archives
+Non-@code{nil} means that @code{gnus-uu} won't peek inside archives
+looking for files to display.
+
+@item gnus-uu-view-and-save
+@vindex gnus-uu-view-and-save
+Non-@code{nil} means that the user will always be asked to save a file
+after viewing it.
+
+@item gnus-uu-ignore-default-view-rules
+@vindex gnus-uu-ignore-default-view-rules
+Non-@code{nil} means that @code{gnus-uu} will ignore the default viewing
+rules.
+
+@item gnus-uu-ignore-default-archive-rules
+@vindex gnus-uu-ignore-default-archive-rules
+Non-@code{nil} means that @code{gnus-uu} will ignore the default archive
+unpacking commands.
+
+@item gnus-uu-kill-carriage-return
+@vindex gnus-uu-kill-carriage-return
+Non-@code{nil} means that @code{gnus-uu} will strip all carriage returns
+from articles.
+
+@item gnus-uu-unmark-articles-not-decoded
+@vindex gnus-uu-unmark-articles-not-decoded
+Non-@code{nil} means that @code{gnus-uu} will mark unsuccessfully
+decoded articles as unread.
+
+@item gnus-uu-correct-stripped-uucode
+@vindex gnus-uu-correct-stripped-uucode
+Non-@code{nil} means that @code{gnus-uu} will @emph{try} to fix
+uuencoded files that have had trailing spaces deleted.
+
+@item gnus-uu-view-with-metamail
+@vindex gnus-uu-view-with-metamail
+@cindex metamail
+Non-@code{nil} means that @code{gnus-uu} will ignore the viewing
+commands defined by the rule variables and just fudge a @sc{mime}
+content type based on the file name. The result will be fed to
+@code{metamail} for viewing.
+
+@item gnus-uu-save-in-digest
+@vindex gnus-uu-save-in-digest
+Non-@code{nil} means that @code{gnus-uu}, when asked to save without
+decoding, will save in digests. If this variable is @code{nil},
+@code{gnus-uu} will just save everything in a file without any
+embellishments. The digesting almost conforms to RFC1153---no easy way
+to specify any meaningful volume and issue numbers were found, so I
+simply dropped them.
+
+@end table
+
+
+@node Uuencoding and Posting
+@subsubsection Uuencoding and Posting
+
+@table @code
+
+@item gnus-uu-post-include-before-composing
+@vindex gnus-uu-post-include-before-composing
+Non-@code{nil} means that @code{gnus-uu} will ask for a file to encode
+before you compose the article. If this variable is @code{t}, you can
+either include an encoded file with @kbd{C-c C-i} or have one included
+for you when you post the article.
+
+@item gnus-uu-post-length
+@vindex gnus-uu-post-length
+Maximum length of an article. The encoded file will be split into how
+many articles it takes to post the entire file.
+
+@item gnus-uu-post-threaded
+@vindex gnus-uu-post-threaded
+Non-@code{nil} means that @code{gnus-uu} will post the encoded file in a
+thread. This may not be smart, as no other decoder I have seen is able
+to follow threads when collecting uuencoded articles. (Well, I have
+seen one package that does that---@code{gnus-uu}, but somehow, I don't
+think that counts...) Default is @code{nil}.
+
+@item gnus-uu-post-separate-description
+@vindex gnus-uu-post-separate-description
+Non-@code{nil} means that the description will be posted in a separate
+article. The first article will typically be numbered (0/x). If this
+variable is @code{nil}, the description the user enters will be included
+at the beginning of the first article, which will be numbered (1/x).
+Default is @code{t}.
+
+@end table
+
+
+@node Viewing Files
+@subsection Viewing Files
+@cindex viewing files
+@cindex pseudo-articles
+
+After decoding, if the file is some sort of archive, Gnus will attempt
+to unpack the archive and see if any of the files in the archive can be
+viewed. For instance, if you have a gzipped tar file @file{pics.tar.gz}
+containing the files @file{pic1.jpg} and @file{pic2.gif}, Gnus will
+uncompress and de-tar the main file, and then view the two pictures.
+This unpacking process is recursive, so if the archive contains archives
+of archives, it'll all be unpacked.
+
+Finally, Gnus will normally insert a @dfn{pseudo-article} for each
+extracted file into the summary buffer. If you go to these
+``articles'', you will be prompted for a command to run (usually Gnus
+will make a suggestion), and then the command will be run.
+
+@vindex gnus-view-pseudo-asynchronously
+If @code{gnus-view-pseudo-asynchronously} is @code{nil}, Emacs will wait
+until the viewing is done before proceeding.
+
+@vindex gnus-view-pseudos
+If @code{gnus-view-pseudos} is @code{automatic}, Gnus will not insert
+the pseudo-articles into the summary buffer, but view them
+immediately. If this variable is @code{not-confirm}, the user won't even
+be asked for a confirmation before viewing is done.
+
+@vindex gnus-view-pseudos-separately
+If @code{gnus-view-pseudos-separately} is non-@code{nil}, one
+pseudo-article will be created for each file to be viewed. If
+@code{nil}, all files that use the same viewing command will be given as
+a list of parameters to that command.
+
+@vindex gnus-insert-pseudo-articles
+If @code{gnus-insert-pseudo-articles} is non-@code{nil}, insert
+pseudo-articles when decoding. It is @code{t} by default.
+
+So; there you are, reading your @emph{pseudo-articles} in your
+@emph{virtual newsgroup} from the @emph{virtual server}; and you think:
+Why isn't anything real anymore? How did we get here?
+
+
+@node Article Treatment
+@section Article Treatment
+
+Reading through this huge manual, you may have quite forgotten that the
+object of newsreaders is to actually, like, read what people have
+written. Reading articles. Unfortunately, people are quite bad at
+writing, so there are tons of functions and variables to make reading
+these articles easier.
+
+@menu
+* Article Highlighting:: You want to make the article look like fruit salad.
+* Article Fontisizing:: Making emphasized text look niced.
+* Article Hiding:: You also want to make certain info go away.
+* Article Washing:: Lots of way-neat functions to make life better.
+* Article Buttons:: Click on URLs, Message-IDs, addresses and the like.
+* Article Date:: Grumble, UT!
+* Article Signature:: What is a signature?
+@end menu
+
+
+@node Article Highlighting
+@subsection Article Highlighting
+@cindex highlight
+
+Not only do you want your article buffer to look like fruit salad, but
+you want it to look like technicolor fruit salad.
+
+@table @kbd
+
+@item W H a
+@kindex W H a (Summary)
+@findex gnus-article-highlight
+Highlight the current article (@code{gnus-article-highlight}).
+
+@item W H h
+@kindex W H h (Summary)
+@findex gnus-article-highlight-headers
+@vindex gnus-header-face-alist
+Highlight the headers (@code{gnus-article-highlight-headers}). The
+highlighting will be done according to the @code{gnus-header-face-alist}
+variable, which is a list where each element has the form @var{(regexp
+name content)}. @var{regexp} is a regular expression for matching the
+header, @var{name} is the face used for highlighting the header name and
+@var{content} is the face for highlighting the header value. The first
+match made will be used. Note that @var{regexp} shouldn't have @samp{^}
+prepended---Gnus will add one.
+
+@item W H c
+@kindex W H c (Summary)
+@findex gnus-article-highlight-citation
+Highlight cited text (@code{gnus-article-highlight-citation}).
+
+Some variables to customize the citation highlights:
+
+@table @code
+@vindex gnus-cite-parse-max-size
+
+@item gnus-cite-parse-max-size
+If the article size if bigger than this variable (which is 25000 by
+default), no citation highlighting will be performed.
+
+@item gnus-cite-prefix-regexp
+@vindex gnus-cite-prefix-regexp
+Regexp matching the longest possible citation prefix on a line.
+
+@item gnus-cite-max-prefix
+@vindex gnus-cite-max-prefix
+Maximum possible length for a citation prefix (default 20).
+
+@item gnus-cite-face-list
+@vindex gnus-cite-face-list
+List of faces used for highlighting citations. When there are citations
+from multiple articles in the same message, Gnus will try to give each
+citation from each article its own face. This should make it easier to
+see who wrote what.
+
+@item gnus-supercite-regexp
+@vindex gnus-supercite-regexp
+Regexp matching normal Supercite attribution lines.
+
+@item gnus-supercite-secondary-regexp
+@vindex gnus-supercite-secondary-regexp
+Regexp matching mangled Supercite attribution lines.
+
+@item gnus-cite-minimum-match-count
+@vindex gnus-cite-minimum-match-count
+Minimum number of identical prefixes we have to see before we believe
+that it's a citation.
+
+@item gnus-cite-attribution-prefix
+@vindex gnus-cite-attribution-prefix
+Regexp matching the beginning of an attribution line.
+
+@item gnus-cite-attribution-suffix
+@vindex gnus-cite-attribution-suffix
+Regexp matching the end of an attribution line.
+
+@item gnus-cite-attribution-face
+@vindex gnus-cite-attribution-face
+Face used for attribution lines. It is merged with the face for the
+cited text belonging to the attribution.
+
+@end table
+
+
+@item W H s
+@kindex W H s (Summary)
+@vindex gnus-signature-separator
+@vindex gnus-signature-face
+@findex gnus-article-highlight-signature
+Highlight the signature (@code{gnus-article-highlight-signature}).
+Everything after @code{gnus-signature-separator} (@pxref{Article
+Signature}) in an article will be considered a signature and will be
+highlighted with @code{gnus-signature-face}, which is @code{italic} by
+default.
+
+@end table
+
+
+@node Article Fontisizing
+@subsection Article Fontisizing
+@cindex emphasis
+@cindex article emphasis
+
+@findex gnus-article-emphasize
+@kindex W e (Summary)
+People commonly add emphasis to words in news articles by writing things
+like @samp{_this_} or @samp{*this*}. Gnus can make this look nicer by
+running the article through the @kbd{W e}
+(@code{gnus-article-emphasize}) command.
+
+@vindex gnus-article-emphasis
+How the emphasis is computed is controlled by the
+@code{gnus-article-emphasis} variable. This is an alist where the first
+element is a regular expression to be matched. The second is a number
+that says what regular expression grouping is used to find the entire
+emphasized word. The third is a number that says what regexp grouping
+should be displayed and highlighted. (The text between these two
+groupings will be hidden.) The fourth is the face used for
+highlighting.
+
+@lisp
+(setq gnus-article-emphasis
+ '(("_\\(\\w+\\)_" 0 1 gnus-emphasis-underline)
+ ("\\*\\(\\w+\\)\\*" 0 1 gnus-emphasis-bold)))
+@end lisp
+
+@vindex gnus-emphasis-underline
+@vindex gnus-emphasis-bold
+@vindex gnus-emphasis-italic
+@vindex gnus-emphasis-underline-bold
+@vindex gnus-emphasis-underline-italic
+@vindex gnus-emphasis-bold-italic
+@vindex gnus-emphasis-underline-bold-italic
+By default, there are seven rules, and they use the following faces:
+@code{gnus-emphasis-bold}, @code{gnus-emphasis-italic},
+@code{gnus-emphasis-underline}, @code{gnus-emphasis-bold-italic},
+@code{gnus-emphasis-underline-italic},
+@code{gnus-emphasis-underline-bold}, and
+@code{gnus-emphasis-underline-bold-italic}.
+
+If you want to change these faces, you can either use @kbd{M-x
+customize}, or you can use @code{copy-face}. For instance, if you want
+to make @code{gnus-emphasis-italic} use a red face instead, you could
+say something like:
+
+@lisp
+(copy-face 'red 'gnus-emphasis-italic)
+@end lisp
+
+
+@node Article Hiding
+@subsection Article Hiding
+@cindex article hiding
+
+Or rather, hiding certain things in each article. There usually is much
+too much cruft in most articles.
+
+@table @kbd
+
+@item W W a
+@kindex W W a (Summary)
+@findex gnus-article-hide
+Do maximum hiding on the summary buffer (@kbd{gnus-article-hide}).
+
+@item W W h
+@kindex W W h (Summary)
+@findex gnus-article-hide-headers
+Hide headers (@code{gnus-article-hide-headers}). @xref{Hiding
+Headers}.
+
+@item W W b
+@kindex W W b (Summary)
+@findex gnus-article-hide-boring-headers
+Hide headers that aren't particularly interesting
+(@code{gnus-article-hide-boring-headers}). @xref{Hiding Headers}.
+
+@item W W s
+@kindex W W s (Summary)
+@findex gnus-article-hide-signature
+Hide signature (@code{gnus-article-hide-signature}). @xref{Article
+Signature}.
+
+@item W W p
+@kindex W W p (Summary)
+@findex gnus-article-hide-pgp
+@vindex gnus-article-hide-pgp-hook
+Hide @sc{pgp} signatures (@code{gnus-article-hide-pgp}). The
+@code{gnus-article-hide-pgp-hook} hook will be run after a @sc{pgp}
+signature has been hidden.
+
+@item W W P
+@kindex W W P (Summary)
+@findex gnus-article-hide-pem
+Hide @sc{pem} (privacy enhanced messages) cruft
+(@code{gnus-article-hide-pem}).
+
+@item W W c
+@kindex W W c (Summary)
+@findex gnus-article-hide-citation
+Hide citation (@code{gnus-article-hide-citation}). Some variables for
+customizing the hiding:
+
+@table @code
+
+@item gnus-cite-hide-percentage
+@vindex gnus-cite-hide-percentage
+If the cited text is of a bigger percentage than this variable (default
+50), hide the cited text.
+
+@item gnus-cite-hide-absolute
+@vindex gnus-cite-hide-absolute
+The cited text must have at least this length (default 10) before it
+is hidden.
+
+@item gnus-cited-text-button-line-format
+@vindex gnus-cited-text-button-line-format
+Gnus adds buttons to show where the cited text has been hidden, and to
+allow toggle hiding the text. The format of the variable is specified
+by this format-like variable (@pxref{Formatting Variables}). These
+specs are valid:
+
+@table @samp
+@item b
+Start point of the hidden text.
+@item e
+End point of the hidden text.
+@item l
+Length of the hidden text.
+@end table
+
+@item gnus-cited-lines-visible
+@vindex gnus-cited-lines-visible
+The number of lines at the beginning of the cited text to leave shown.
+
+@end table
+
+@item W W C
+@kindex W W C (Summary)
+@findex gnus-article-hide-citation-in-followups
+Hide cited text in articles that aren't roots
+(@code{gnus-article-hide-citation-in-followups}). This isn't very
+useful as an interactive command, but might be a handy function to stick
+in @code{gnus-article-display-hook} (@pxref{Customizing Articles}).
+
+@end table
+
+All these ``hiding'' commands are toggles, but if you give a negative
+prefix to these commands, they will show what they have previously
+hidden. If you give a positive prefix, they will always hide.
+
+Also @pxref{Article Highlighting} for further variables for
+citation customization.
+
+
+@node Article Washing
+@subsection Article Washing
+@cindex washing
+@cindex article washing
+
+We call this ``article washing'' for a really good reason. Namely, the
+@kbd{A} key was taken, so we had to use the @kbd{W} key instead.
+
+@dfn{Washing} is defined by us as ``changing something from something to
+something else'', but normally results in something looking better.
+Cleaner, perhaps.
+
+@table @kbd
+
+@item W l
+@kindex W l (Summary)
+@findex gnus-summary-stop-page-breaking
+Remove page breaks from the current article
+(@code{gnus-summary-stop-page-breaking}).
+
+@item W r
+@kindex W r (Summary)
+@findex gnus-summary-caesar-message
+@c @icon{gnus-summary-caesar-message}
+Do a Caesar rotate (rot13) on the article buffer
+(@code{gnus-summary-caesar-message}).
+Unreadable articles that tell you to read them with Caesar rotate or rot13.
+(Typically offensive jokes and such.)
+
+It's commonly called ``rot13'' because each letter is rotated 13
+positions in the alphabet, e. g. @samp{B} (letter #2) -> @samp{O} (letter
+#15). It is sometimes referred to as ``Caesar rotate'' because Caesar
+is rumoured to have employed this form of, uh, somewhat weak encryption.
+
+@item W t
+@kindex W t (Summary)
+@findex gnus-summary-toggle-header
+Toggle whether to display all headers in the article buffer
+(@code{gnus-summary-toggle-header}).
+
+@item W v
+@kindex W v (Summary)
+@findex gnus-summary-verbose-header
+Toggle whether to display all headers in the article buffer permanently
+(@code{gnus-summary-verbose-header}).
+
+@item W m
+@kindex W m (Summary)
+@findex gnus-summary-toggle-mime
+Toggle whether to run the article through @sc{mime} before displaying
+(@code{gnus-summary-toggle-mime}).
+
+@item W o
+@kindex W o (Summary)
+@findex gnus-article-treat-overstrike
+Treat overstrike (@code{gnus-article-treat-overstrike}).
+
+@item W w
+@kindex W w (Summary)
+@findex gnus-article-fill-cited-article
+Do word wrap (@code{gnus-article-fill-cited-article}). If you use this
+function in @code{gnus-article-display-hook}, it should be run fairly
+late and certainly after any highlighting.
+
+You can give the command a numerical prefix to specify the width to use
+when filling.
+
+@item W c
+@kindex W c (Summary)
+@findex gnus-article-remove-cr
+Remove CR (i. e., @samp{^M}s on the end of the lines)
+(@code{gnus-article-remove-cr}).
+
+@item W q
+@kindex W q (Summary)
+@findex gnus-article-de-quoted-unreadable
+Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}).
+Quoted-Printable is one common @sc{mime} encoding employed when sending
+non-ASCII (i. e., 8-bit) articles. It typically makes strings like
+@samp{déjà vu} look like @samp{d=E9j=E0 vu}, which doesn't look very
+readable to me.
+
+@item W f
+@kindex W f (Summary)
+@cindex x-face
+@findex gnus-article-display-x-face
+@findex gnus-article-x-face-command
+@vindex gnus-article-x-face-command
+@vindex gnus-article-x-face-too-ugly
+@iftex
+@iflatex
+\gnusxface{tmp/xface-karlheg.ps}
+\gnusxface{tmp/xface-kyle.ps}
+\gnusxface{tmp/xface-smb.ps}
+@end iflatex
+@end iftex
+Look for and display any X-Face headers
+(@code{gnus-article-display-x-face}). The command executed by this
+function is given by the @code{gnus-article-x-face-command} variable.
+If this variable is a string, this string will be executed in a
+sub-shell. If it is a function, this function will be called with the
+face as the argument. If the @code{gnus-article-x-face-too-ugly} (which
+is a regexp) matches the @code{From} header, the face will not be shown.
+The default action under Emacs is to fork off an @code{xv} to view the
+face; under XEmacs the default action is to display the face before the
+@code{From} header. (It's nicer if XEmacs has been compiled with X-Face
+support---that will make display somewhat faster. If there's no native
+X-Face support, Gnus will try to convert the @code{X-Face} header using
+external programs from the @code{pbmplus} package and friends.) If you
+want to have this function in the display hook, it should probably come
+last.
+
+@item W b
+@kindex W b (Summary)
+@findex gnus-article-add-buttons
+Add clickable buttons to the article (@code{gnus-article-add-buttons}).
+@xref{Article Buttons}
+
+@item W B
+@kindex W B (Summary)
+@findex gnus-article-add-buttons-to-head
+Add clickable buttons to the article headers
+(@code{gnus-article-add-buttons-to-head}).
+
+@item W E l
+@kindex W E l (Summary)
+@findex gnus-article-strip-leading-blank-lines
+Remove all blank lines from the beginning of the article
+(@code{gnus-article-strip-leading-blank-lines}).
+
+@item W E m
+@kindex W E m (Summary)
+@findex gnus-article-strip-multiple-blank-lines
+Replace all blank lines with empty lines and then all multiple empty
+lines with a single empty line.
+(@code{gnus-article-strip-multiple-blank-lines}).
+
+@item W E t
+@kindex W E t (Summary)
+@findex gnus-article-remove-trailing-blank-lines
+Remove all blank lines at the end of the article
+(@code{gnus-article-remove-trailing-blank-lines}).
+
+@item W E a
+@kindex W E a (Summary)
+@findex gnus-article-strip-blank-lines
+Do all the three commands above
+(@code{gnus-article-strip-blank-lines}).
+
+@item W E s
+@kindex W E s (Summary)
+@findex gnus-article-strip-leading-space
+Remove all white space from the beginning of all lines of the article
+body (@code{gnus-article-strip-leading-space}).
+
+@end table
+
+
+@node Article Buttons
+@subsection Article Buttons
+@cindex buttons
+
+People often include references to other stuff in articles, and it would
+be nice if Gnus could just fetch whatever it is that people talk about
+with the minimum of fuzz when you hit @kbd{RET} or use the middle mouse
+button on these references.
+
+Gnus adds @dfn{buttons} to certain standard references by default:
+Well-formed URLs, mail addresses and Message-IDs. This is controlled by
+two variables, one that handles article bodies and one that handles
+article heads:
+
+@table @code
+
+@item gnus-button-alist
+@vindex gnus-button-alist
+This is an alist where each entry has this form:
+
+@lisp
+(REGEXP BUTTON-PAR USE-P FUNCTION DATA-PAR)
+@end lisp
+
+@table @var
+
+@item regexp
+All text that match this regular expression will be considered an
+external reference. Here's a typical regexp that matches embedded URLs:
+@samp{<URL:\\([^\n\r>]*\\)>}.
+
+@item button-par
+Gnus has to know which parts of the matches is to be highlighted. This
+is a number that says what sub-expression of the regexp is to be
+highlighted. If you want it all highlighted, you use 0 here.
+
+@item use-p
+This form will be @code{eval}ed, and if the result is non-@code{nil},
+this is considered a match. This is useful if you want extra sifting to
+avoid false matches.
+
+@item function
+This function will be called when you click on this button.
+
+@item data-par
+As with @var{button-par}, this is a sub-expression number, but this one
+says which part of the match is to be sent as data to @var{function}.
+
+@end table
+
+So the full entry for buttonizing URLs is then
+
+@lisp
+("<URL:\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
+@end lisp
+
+@item gnus-header-button-alist
+@vindex gnus-header-button-alist
+This is just like the other alist, except that it is applied to the
+article head only, and that each entry has an additional element that is
+used to say what headers to apply the buttonize coding to:
+
+@lisp
+(HEADER REGEXP BUTTON-PAR USE-P FUNCTION DATA-PAR)
+@end lisp
+
+@var{HEADER} is a regular expression.
+
+@item gnus-button-url-regexp
+@vindex gnus-button-url-regexp
+A regular expression that matches embedded URLs. It is used in the
+default values of the variables above.
+
+@item gnus-article-button-face
+@vindex gnus-article-button-face
+Face used on buttons.
+
+@item gnus-article-mouse-face
+@vindex gnus-article-mouse-face
+Face used when the mouse cursor is over a button.
+
+@end table
+
+
+@node Article Date
+@subsection Article Date
+
+The date is most likely generated in some obscure timezone you've never
+heard of, so it's quite nice to be able to find out what the time was
+when the article was sent.
+
+@table @kbd
+
+@item W T u
+@kindex W T u (Summary)
+@findex gnus-article-date-ut
+Display the date in UT (aka. GMT, aka ZULU)
+(@code{gnus-article-date-ut}).
+
+@item W T l
+@kindex W T l (Summary)
+@findex gnus-article-date-local
+Display the date in the local timezone (@code{gnus-article-date-local}).
+
+@item W T s
+@kindex W T s (Summary)
+@vindex gnus-article-time-format
+@findex gnus-article-date-user
+@findex format-time-string
+Display the date using a user-defined format
+(@code{gnus-article-date-user}). The format is specified by the
+@code{gnus-article-time-format} variable, and is a string that's passed
+to @code{format-time-string}. See the documentation of that variable
+for a list of possible format specs.
+
+@item W T e
+@kindex W T e (Summary)
+@findex gnus-article-date-lapsed
+Say how much time has elapsed between the article was posted and now
+(@code{gnus-article-date-lapsed}).
+
+@item W T o
+@kindex W T o (Summary)
+@findex gnus-article-date-original
+Display the original date (@code{gnus-article-date-original}). This can
+be useful if you normally use some other conversion function and are
+worried that it might be doing something totally wrong. Say, claiming
+that the article was posted in 1854. Although something like that is
+@emph{totally} impossible. Don't you trust me? *titter*
+
+@end table
+
+
+@node Article Signature
+@subsection Article Signature
+@cindex signatures
+@cindex article signature
+
+@vindex gnus-signature-separator
+Each article is divided into two parts---the head and the body. The
+body can be divided into a signature part and a text part. The variable
+that says what is to be considered a signature is
+@code{gnus-signature-separator}. This is normally the standard
+@samp{^-- $} as mandated by son-of-RFC 1036. However, many people use
+non-standard signature separators, so this variable can also be a list
+of regular expressions to be tested, one by one. (Searches are done
+from the end of the body towards the beginning.) One likely value is:
+
+@lisp
+(setq gnus-signature-separator
+ '("^-- $" ; The standard
+ "^-- *$" ; A common mangling
+ "^-------*$" ; Many people just use a looong
+ ; line of dashes. Shame!
+ "^ *--------*$" ; Double-shame!
+ "^________*$" ; Underscores are also popular
+ "^========*$")) ; Pervert!
+@end lisp
+
+The more permissive you are, the more likely it is that you'll get false
+positives.
+
+@vindex gnus-signature-limit
+@code{gnus-signature-limit} provides a limit to what is considered a
+signature.
+
+@enumerate
+@item
+If it is an integer, no signature may be longer (in characters) than
+that integer.
+@item
+If it is a floating point number, no signature may be longer (in lines)
+than that number.
+@item
+If it is a function, the function will be called without any parameters,
+and if it returns @code{nil}, there is no signature in the buffer.
+@item
+If it is a string, it will be used as a regexp. If it matches, the text
+in question is not a signature.
+@end enumerate
+
+This variable can also be a list where the elements may be of the types
+listed above. Here's an example:
+
+@lisp
+(setq gnus-signature-limit
+ '(200.0 "^---*Forwarded article"))
+@end lisp
+
+This means that if there are more than 200 lines after the signature
+separator, or the text after the signature separator is matched by
+the regular expression @samp{^---*Forwarded article}, then it isn't a
+signature after all.
+
+
+@node Article Commands
+@section Article Commands
+
+@table @kbd
+
+@item A P
+@cindex PostScript
+@cindex printing
+@kindex A P (Summary)
+@vindex gnus-ps-print-hook
+@findex gnus-summary-print-article
+Generate and print a PostScript image of the article buffer
+(@code{gnus-summary-print-article}). @code{gnus-ps-print-hook} will be
+run just before printing the buffer.
+
+@end table
+
+
+@node Summary Sorting
+@section Summary Sorting
+@cindex summary sorting
+
+You can have the summary buffer sorted in various ways, even though I
+can't really see why you'd want that.
+
+@table @kbd
+
+@item C-c C-s C-n
+@kindex C-c C-s C-n (Summary)
+@findex gnus-summary-sort-by-number
+Sort by article number (@code{gnus-summary-sort-by-number}).
+
+@item C-c C-s C-a
+@kindex C-c C-s C-a (Summary)
+@findex gnus-summary-sort-by-author
+Sort by author (@code{gnus-summary-sort-by-author}).
+
+@item C-c C-s C-s
+@kindex C-c C-s C-s (Summary)
+@findex gnus-summary-sort-by-subject
+Sort by subject (@code{gnus-summary-sort-by-subject}).
+
+@item C-c C-s C-d
+@kindex C-c C-s C-d (Summary)
+@findex gnus-summary-sort-by-date
+Sort by date (@code{gnus-summary-sort-by-date}).
+
+@item C-c C-s C-l
+@kindex C-c C-s C-l (Summary)
+@findex gnus-summary-sort-by-lines
+Sort by lines (@code{gnus-summary-sort-by-lines}).
+
+@item C-c C-s C-i
+@kindex C-c C-s C-i (Summary)
+@findex gnus-summary-sort-by-score
+Sort by score (@code{gnus-summary-sort-by-score}).
+@end table
+
+These functions will work both when you use threading and when you don't
+use threading. In the latter case, all summary lines will be sorted,
+line by line. In the former case, sorting will be done on a
+root-by-root basis, which might not be what you were looking for. To
+toggle whether to use threading, type @kbd{T T} (@pxref{Thread
+Commands}).
+
+
+@node Finding the Parent
+@section Finding the Parent
+@cindex parent articles
+@cindex referring articles
+
+@table @kbd
+@item ^
+@kindex ^ (Summary)
+@findex gnus-summary-refer-parent-article
+If you'd like to read the parent of the current article, and it is not
+displayed in the summary buffer, you might still be able to. That is,
+if the current group is fetched by @sc{nntp}, the parent hasn't expired
+and the @code{References} in the current article are not mangled, you
+can just press @kbd{^} or @kbd{A r}
+(@code{gnus-summary-refer-parent-article}). If everything goes well,
+you'll get the parent. If the parent is already displayed in the
+summary buffer, point will just move to this article.
+
+If given a positive numerical prefix, fetch that many articles back into
+the ancestry. If given a negative numerical prefix, fetch just that
+ancestor. So if you say @kbd{3 ^}, Gnus will fetch the parent, the
+grandparent and the grandgrandparent of the current article. If you say
+@kbd{-3 ^}, Gnus will only fetch the grandgrandparent of the current
+article.
+
+@item A R (Summary)
+@findex gnus-summary-refer-references
+@kindex A R (Summary)
+Fetch all articles mentioned in the @code{References} header of the
+article (@code{gnus-summary-refer-references}).
+
+@item A T (Summary)
+@findex gnus-summary-refer-thread
+@kindex A T (Summary)
+Display the full thread where the current article appears
+(@code{gnus-summary-refer-thread}). This command has to fetch all the
+headers in the current group to work, so it usually takes a while. If
+you do it often, you may consider setting @code{gnus-fetch-old-headers}
+to @code{invisible} (@pxref{Filling In Threads}). This won't have any
+visible effects normally, but it'll make this command work a whole lot
+faster. Of course, it'll make group entry somewhat slow.
+
+@vindex gnus-refer-thread-limit
+The @code{gnus-refer-thread-limit} variable says how many old (i. e.,
+articles before the first displayed in the current group) headers to
+fetch when doing this command. The default is 200. If @code{t}, all
+the available headers will be fetched. This variable can be overridden
+by giving the @kbd{A T} command a numerical prefix.
+
+@item M-^ (Summary)
+@findex gnus-summary-refer-article
+@kindex M-^ (Summary)
+@cindex Message-ID
+@cindex fetching by Message-ID
+You can also ask the @sc{nntp} server for an arbitrary article, no
+matter what group it belongs to. @kbd{M-^}
+(@code{gnus-summary-refer-article}) will ask you for a
+@code{Message-ID}, which is one of those long, hard-to-read thingies
+that look something like @samp{<38o6up$6f2@@hymir.ifi.uio.no>}. You
+have to get it all exactly right. No fuzzy searches, I'm afraid.
+@end table
+
+The current select method will be used when fetching by
+@code{Message-ID} from non-news select method, but you can override this
+by giving this command a prefix.
+
+@vindex gnus-refer-article-method
+If the group you are reading is located on a backend that does not
+support fetching by @code{Message-ID} very well (like @code{nnspool}),
+you can set @code{gnus-refer-article-method} to an @sc{nntp} method. It
+would, perhaps, be best if the @sc{nntp} server you consult is the one
+updating the spool you are reading from, but that's not really
+necessary.
+
+Most of the mail backends support fetching by @code{Message-ID}, but do
+not do a particularly excellent job at it. That is, @code{nnmbox} and
+@code{nnbabyl} are able to locate articles from any groups, while
+@code{nnml} and @code{nnfolder} are only able to locate articles that
+have been posted to the current group. (Anything else would be too time
+consuming.) @code{nnmh} does not support this at all.
+
+
+@node Alternative Approaches
+@section Alternative Approaches
+
+Different people like to read news using different methods. This being
+Gnus, we offer a small selection of minor modes for the summary buffers.
+
+@menu
+* Pick and Read:: First mark articles and then read them.
+* Binary Groups:: Auto-decode all articles.
+@end menu
+
+
+@node Pick and Read
+@subsection Pick and Read
+@cindex pick and read
+
+Some newsreaders (like @code{nn} and, uhm, @code{Netnews} on VM/CMS) use
+a two-phased reading interface. The user first marks in a summary
+buffer the articles she wants to read. Then she starts reading the
+articles with just an article buffer displayed.
+
+@findex gnus-pick-mode
+@kindex M-x gnus-pick-mode
+Gnus provides a summary buffer minor mode that allows
+this---@code{gnus-pick-mode}. This basically means that a few process
+mark commands become one-keystroke commands to allow easy marking, and
+it provides one additional command for switching to the summary buffer.
+
+Here are the available keystrokes when using pick mode:
+
+@table @kbd
+@item .
+@kindex . (Pick)
+@findex gnus-summary-mark-as-processable
+Pick the article on the current line
+(@code{gnus-summary-mark-as-processable}). If given a numerical prefix,
+go to that article and pick it. (The line number is normally displayed
+at the beginning of the summary pick lines.)
+
+@item SPACE
+@kindex SPACE (Pick)
+@findex gnus-pick-next-page
+Scroll the summary buffer up one page (@code{gnus-pick-next-page}). If
+at the end of the buffer, start reading the picked articles.
+
+@item u
+@kindex u (Pick)
+@findex gnus-summary-unmark-as-processable
+Unpick the article (@code{gnus-summary-unmark-as-processable}).
+
+@item U
+@kindex U (Pick)
+@findex gnus-summary-unmark-all-processable
+Unpick all articles (@code{gnus-summary-unmark-all-processable}).
+
+@item t
+@kindex t (Pick)
+@findex gnus-uu-mark-thread
+Pick the thread (@code{gnus-uu-mark-thread}).
+
+@item T
+@kindex T (Pick)
+@findex gnus-uu-unmark-thread
+Unpick the thread (@code{gnus-uu-unmark-thread}).
+
+@item r
+@kindex r (Pick)
+@findex gnus-uu-mark-region
+Pick the region (@code{gnus-uu-mark-region}).
+
+@item R
+@kindex R (Pick)
+@findex gnus-uu-unmark-region
+Unpick the region (@code{gnus-uu-unmark-region}).
+
+@item e
+@kindex e (Pick)
+@findex gnus-uu-mark-by-regexp
+Pick articles that match a regexp (@code{gnus-uu-mark-by-regexp}).
+
+@item E
+@kindex E (Pick)
+@findex gnus-uu-unmark-by-regexp
+Unpick articles that match a regexp (@code{gnus-uu-unmark-by-regexp}).
+
+@item b
+@kindex b (Pick)
+@findex gnus-uu-mark-buffer
+Pick the buffer (@code{gnus-uu-mark-buffer}).
+
+@item B
+@kindex B (Pick)
+@findex gnus-uu-unmark-buffer
+Unpick the buffer (@code{gnus-uu-unmark-buffer}).
+
+@item RET
+@kindex RET (Pick)
+@findex gnus-pick-start-reading
+@vindex gnus-pick-display-summary
+Start reading the picked articles (@code{gnus-pick-start-reading}). If
+given a prefix, mark all unpicked articles as read first. If
+@code{gnus-pick-display-summary} is non-@code{nil}, the summary buffer
+will still be visible when you are reading.
+
+@end table
+
+If this sounds like a good idea to you, you could say:
+
+@lisp
+(add-hook 'gnus-summary-mode-hook 'gnus-pick-mode)
+@end lisp
+
+@vindex gnus-pick-mode-hook
+@code{gnus-pick-mode-hook} is run in pick minor mode buffers.
+
+@vindex gnus-mark-unpicked-articles-as-read
+If @code{gnus-mark-unpicked-articles-as-read} is non-@code{nil}, mark
+all unpicked articles as read. The default is @code{nil}.
+
+@vindex gnus-summary-pick-line-format
+The summary line format in pick mode is slightly different from the
+standard format. At the beginning of each line the line number is
+displayed. The pick mode line format is controlled by the
+@code{gnus-summary-pick-line-format} variable (@pxref{Formatting
+Variables}). It accepts the same format specs that
+@code{gnus-summary-line-format} does (@pxref{Summary Buffer Lines}).
+
+
+@node Binary Groups
+@subsection Binary Groups
+@cindex binary groups
+
+@findex gnus-binary-mode
+@kindex M-x gnus-binary-mode
+If you spend much time in binary groups, you may grow tired of hitting
+@kbd{X u}, @kbd{n}, @kbd{RET} all the time. @kbd{M-x gnus-binary-mode}
+is a minor mode for summary buffers that makes all ordinary Gnus article
+selection functions uudecode series of articles and display the result
+instead of just displaying the articles the normal way.
+
+@kindex g (Binary)
+@findex gnus-binary-show-article
+The only way, in fact, to see the actual articles is the @kbd{g}
+command, when you have turned on this mode
+(@code{gnus-binary-show-article}).
+
+@vindex gnus-binary-mode-hook
+@code{gnus-binary-mode-hook} is called in binary minor mode buffers.
+
+
+@node Tree Display
+@section Tree Display
+@cindex trees
+
+@vindex gnus-use-trees
+If you don't like the normal Gnus summary display, you might try setting
+@code{gnus-use-trees} to @code{t}. This will create (by default) an
+additional @dfn{tree buffer}. You can execute all summary mode commands
+in the tree buffer.
+
+There are a few variables to customize the tree display, of course:
+
+@table @code
+@item gnus-tree-mode-hook
+@vindex gnus-tree-mode-hook
+A hook called in all tree mode buffers.
+
+@item gnus-tree-mode-line-format
+@vindex gnus-tree-mode-line-format
+A format string for the mode bar in the tree mode buffers. The default
+is @samp{Gnus: %%b [%A] %Z}. For a list of valid specs, @pxref{Summary
+Buffer Mode Line}.
+
+@item gnus-selected-tree-face
+@vindex gnus-selected-tree-face
+Face used for highlighting the selected article in the tree buffer. The
+default is @code{modeline}.
+
+@item gnus-tree-line-format
+@vindex gnus-tree-line-format
+A format string for the tree nodes. The name is a bit of a misnomer,
+though---it doesn't define a line, but just the node. The default value
+is @samp{%(%[%3,3n%]%)}, which displays the first three characters of
+the name of the poster. It is vital that all nodes are of the same
+length, so you @emph{must} use @samp{%4,4n}-like specifiers.
+
+Valid specs are:
+
+@table @samp
+@item n
+The name of the poster.
+@item f
+The @code{From} header.
+@item N
+The number of the article.
+@item [
+The opening bracket.
+@item ]
+The closing bracket.
+@item s
+The subject.
+@end table
+
+@xref{Formatting Variables}.
+
+Variables related to the display are:
+
+@table @code
+@item gnus-tree-brackets
+@vindex gnus-tree-brackets
+This is used for differentiating between ``real'' articles and
+``sparse'' articles. The format is @var{((real-open . real-close)
+(sparse-open . sparse-close) (dummy-open . dummy-close))}, and the
+default is @code{((?[ . ?]) (?( . ?)) (?@{ . ?@}))}.
+
+@item gnus-tree-parent-child-edges
+@vindex gnus-tree-parent-child-edges
+This is a list that contains the characters used for connecting parent
+nodes to their children. The default is @code{(?- ?\\ ?|)}.
+
+@end table
+
+@item gnus-tree-minimize-window
+@vindex gnus-tree-minimize-window
+If this variable is non-@code{nil}, Gnus will try to keep the tree
+buffer as small as possible to allow more room for the other Gnus
+windows. If this variable is a number, the tree buffer will never be
+higher than that number. The default is @code{t}. Note that if you
+have several windows displayed side-by-side in a frame and the tree
+buffer is one of these, minimizing the tree window will also resize all
+other windows displayed next to it.
+
+@item gnus-generate-tree-function
+@vindex gnus-generate-tree-function
+@findex gnus-generate-horizontal-tree
+@findex gnus-generate-vertical-tree
+The function that actually generates the thread tree. Two predefined
+functions are available: @code{gnus-generate-horizontal-tree} and
+@code{gnus-generate-vertical-tree} (which is the default).
+
+@end table
+
+Here's an example from a horizontal tree buffer:
+
+@example
+@{***@}-(***)-[odd]-[Gun]
+ | \[Jan]
+ | \[odd]-[Eri]
+ | \(***)-[Eri]
+ | \[odd]-[Paa]
+ \[Bjo]
+ \[Gun]
+ \[Gun]-[Jor]
+@end example
+
+Here's the same thread displayed in a vertical tree buffer:
+
+@example
+@{***@}
+ |--------------------------\-----\-----\
+(***) [Bjo] [Gun] [Gun]
+ |--\-----\-----\ |
+[odd] [Jan] [odd] (***) [Jor]
+ | | |--\
+[Gun] [Eri] [Eri] [odd]
+ |
+ [Paa]
+@end example
+
+If you're using horizontal trees, it might be nice to display the trees
+side-by-side with the summary buffer. You could add something like the
+following to your @file{.gnus.el} file:
+
+@lisp
+(setq gnus-use-trees t
+ gnus-generate-tree-function 'gnus-generate-horizontal-tree
+ gnus-tree-minimize-window nil)
+(gnus-add-configuration
+ '(article
+ (vertical 1.0
+ (horizontal 0.25
+ (summary 0.75 point)
+ (tree 1.0))
+ (article 1.0))))
+@end lisp
+
+@xref{Windows Configuration}.
+
+
+@node Mail Group Commands
+@section Mail Group Commands
+@cindex mail group commands
+
+Some commands only make sense in mail groups. If these commands are
+invalid in the current group, they will raise a hell and let you know.
+
+All these commands (except the expiry and edit commands) use the
+process/prefix convention (@pxref{Process/Prefix}).
+
+@table @kbd
+
+@item B e
+@kindex B e (Summary)
+@findex gnus-summary-expire-articles
+Expire all expirable articles in the group
+(@code{gnus-summary-expire-articles}).
+
+@item B M-C-e
+@kindex B M-C-e (Summary)
+@findex gnus-summary-expire-articles-now
+Delete all the expirable articles in the group
+(@code{gnus-summary-expire-articles-now}). This means that @strong{all}
+articles eligible for expiry in the current group will
+disappear forever into that big @file{/dev/null} in the sky.
+
+@item B DEL
+@kindex B DEL (Summary)
+@findex gnus-summary-delete-article
+@c @icon{gnus-summary-mail-delete}
+Delete the mail article. This is ``delete'' as in ``delete it from your
+disk forever and ever, never to return again.'' Use with caution.
+(@code{gnus-summary-delete-article}).
+
+@item B m
+@kindex B m (Summary)
+@cindex move mail
+@findex gnus-summary-move-article
+Move the article from one mail group to another
+(@code{gnus-summary-move-article}).
+
+@item B c
+@kindex B c (Summary)
+@cindex copy mail
+@findex gnus-summary-copy-article
+@c @icon{gnus-summary-mail-copy}
+Copy the article from one group (mail group or not) to a mail group
+(@code{gnus-summary-copy-article}).
+
+@item B C
+@kindex B C (Summary)
+@cindex crosspost mail
+@findex gnus-summary-crosspost-article
+Crosspost the current article to some other group
+(@code{gnus-summary-crosspost-article}). This will create a new copy of
+the article in the other group, and the Xref headers of the article will
+be properly updated.
+
+@item B i
+@kindex B i (Summary)
+@findex gnus-summary-import-article
+Import an arbitrary file into the current mail newsgroup
+(@code{gnus-summary-import-article}). You will be prompted for a file
+name, a @code{From} header and a @code{Subject} header.
+
+@item B r
+@kindex B r (Summary)
+@findex gnus-summary-respool-article
+Respool the mail article (@code{gnus-summary-move-article}).
+@code{gnus-summary-respool-default-method} will be used as the default
+select method when respooling. This variable is @code{nil} by default,
+which means that the current group select method will be used instead.
+
+@item B w
+@itemx e
+@kindex B w (Summary)
+@kindex e (Summary)
+@findex gnus-summary-edit-article
+@kindex C-c C-c (Article)
+Edit the current article (@code{gnus-summary-edit-article}). To finish
+editing and make the changes permanent, type @kbd{C-c C-c}
+(@kbd{gnus-summary-edit-article-done}). If you give a prefix to the
+@kbd{C-c C-c} command, Gnus won't re-highlight the article.
+
+@item B q
+@kindex B q (Summary)
+@findex gnus-summary-respool-query
+If you want to re-spool an article, you might be curious as to what group
+the article will end up in before you do the re-spooling. This command
+will tell you (@code{gnus-summary-respool-query}).
+
+@item B p
+@kindex B p (Summary)
+@findex gnus-summary-article-posted-p
+Some people have a tendency to send you "courtesy" copies when they
+follow up to articles you have posted. These usually have a
+@code{Newsgroups} header in them, but not always. This command
+(@code{gnus-summary-article-posted-p}) will try to fetch the current
+article from your news server (or rather, from
+@code{gnus-refer-article-method} or @code{gnus-select-method}) and will
+report back whether it found the article or not. Even if it says that
+it didn't find the article, it may have been posted anyway---mail
+propagation is much faster than news propagation, and the news copy may
+just not have arrived yet.
+
+@end table
+
+@vindex gnus-move-split-methods
+@cindex moving articles
+If you move (or copy) articles regularly, you might wish to have Gnus
+suggest where to put the articles. @code{gnus-move-split-methods} is a
+variable that uses the same syntax as @code{gnus-split-methods}
+(@pxref{Saving Articles}). You may customize that variable to create
+suggestions you find reasonable.
+
+@lisp
+(setq gnus-move-split-methods
+ '(("^From:.*Lars Magne" "nnml:junk")
+ ("^Subject:.*gnus" "nnfolder:important")
+ (".*" "nnml:misc")))
+@end lisp
+
+
+@node Various Summary Stuff
+@section Various Summary Stuff
+
+@menu
+* Summary Group Information:: Information oriented commands.
+* Searching for Articles:: Multiple article commands.
+* Summary Generation Commands:: (Re)generating the summary buffer.
+* Really Various Summary Commands:: Those pesky non-conformant commands.
+@end menu
+
+@table @code
+@vindex gnus-summary-mode-hook
+@item gnus-summary-mode-hook
+This hook is called when creating a summary mode buffer.
+
+@vindex gnus-summary-generate-hook
+@item gnus-summary-generate-hook
+This is called as the last thing before doing the threading and the
+generation of the summary buffer. It's quite convenient for customizing
+the threading variables based on what data the newsgroup has. This hook
+is called from the summary buffer after most summary buffer variables
+have been set.
+
+@vindex gnus-summary-prepare-hook
+@item gnus-summary-prepare-hook
+It is called after the summary buffer has been generated. You might use
+it to, for instance, highlight lines or modify the look of the buffer in
+some other ungodly manner. I don't care.
+
+@vindex gnus-summary-ignore-duplicates
+@item gnus-summary-ignore-duplicates
+When Gnus discovers two articles that have the same @code{Message-ID},
+it has to do something drastic. No articles are allowed to have the
+same @code{Message-ID}, but this may happen when reading mail from some
+sources. Gnus allows you to customize what happens with this variable.
+If it is @code{nil} (which is the default), Gnus will rename the
+@code{Message-ID} (for display purposes only) and display the article as
+any other article. If this variable is @code{t}, it won't display the
+article---it'll be as if it never existed.
+
+@end table
+
+
+@node Summary Group Information
+@subsection Summary Group Information
+
+@table @kbd
+
+@item H f
+@kindex H f (Summary)
+@findex gnus-summary-fetch-faq
+@vindex gnus-group-faq-directory
+Try to fetch the FAQ (list of frequently asked questions) for the
+current group (@code{gnus-summary-fetch-faq}). Gnus will try to get the
+FAQ from @code{gnus-group-faq-directory}, which is usually a directory
+on a remote machine. This variable can also be a list of directories.
+In that case, giving a prefix to this command will allow you to choose
+between the various sites. @code{ange-ftp} or @code{efs} will probably
+be used for fetching the file.
+
+@item H d
+@kindex H d (Summary)
+@findex gnus-summary-describe-group
+Give a brief description of the current group
+(@code{gnus-summary-describe-group}). If given a prefix, force
+rereading the description from the server.
+
+@item H h
+@kindex H h (Summary)
+@findex gnus-summary-describe-briefly
+Give an extremely brief description of the most important summary
+keystrokes (@code{gnus-summary-describe-briefly}).
+
+@item H i
+@kindex H i (Summary)
+@findex gnus-info-find-node
+Go to the Gnus info node (@code{gnus-info-find-node}).
+@end table
+
+
+@node Searching for Articles
+@subsection Searching for Articles
+
+@table @kbd
+
+@item M-s
+@kindex M-s (Summary)
+@findex gnus-summary-search-article-forward
+Search through all subsequent articles for a regexp
+(@code{gnus-summary-search-article-forward}).
+
+@item M-r
+@kindex M-r (Summary)
+@findex gnus-summary-search-article-backward
+Search through all previous articles for a regexp
+(@code{gnus-summary-search-article-backward}).
+
+@item &
+@kindex & (Summary)
+@findex gnus-summary-execute-command
+This command will prompt you for a header field, a regular expression to
+match on this field, and a command to be executed if the match is made
+(@code{gnus-summary-execute-command}). If given a prefix, search
+backward instead.
+
+@item M-&
+@kindex M-& (Summary)
+@findex gnus-summary-universal-argument
+Perform any operation on all articles that have been marked with
+the process mark (@code{gnus-summary-universal-argument}).
+@end table
+
+@node Summary Generation Commands
+@subsection Summary Generation Commands
+
+@table @kbd
+
+@item Y g
+@kindex Y g (Summary)
+@findex gnus-summary-prepare
+Regenerate the current summary buffer (@code{gnus-summary-prepare}).
+
+@item Y c
+@kindex Y c (Summary)
+@findex gnus-summary-insert-cached-articles
+Pull all cached articles (for the current group) into the summary buffer
+(@code{gnus-summary-insert-cached-articles}).
+
+@end table
+
+
+@node Really Various Summary Commands
+@subsection Really Various Summary Commands
+
+@table @kbd
+
+@item C-d
+@kindex C-d (Summary)
+@findex gnus-summary-enter-digest-group
+If the current article is a collection of other articles (for instance,
+a digest), you might use this command to enter a group based on the that
+article (@code{gnus-summary-enter-digest-group}). Gnus will try to
+guess what article type is currently displayed unless you give a prefix
+to this command, which forces a ``digest'' interpretation. Basically,
+whenever you see a message that is a collection of other messages of
+some format, you @kbd{C-d} and read these messages in a more convenient
+fashion.
+
+@item M-C-d
+@kindex M-C-d (Summary)
+@findex gnus-summary-read-document
+This command is very similar to the one above, but lets you gather
+several documents into one biiig group
+(@code{gnus-summary-read-document}). It does this by opening several
+@code{nndoc} groups for each document, and then opening an
+@code{nnvirtual} group on top of these @code{nndoc} groups. This
+command understands the process/prefix convention
+(@pxref{Process/Prefix}).
+
+@item C-t
+@kindex C-t (Summary)
+@findex gnus-summary-toggle-truncation
+Toggle truncation of summary lines
+(@code{gnus-summary-toggle-truncation}). This will probably confuse the
+line centering function in the summary buffer, so it's not a good idea
+to have truncation switched off while reading articles.
+
+@item =
+@kindex = (Summary)
+@findex gnus-summary-expand-window
+Expand the summary buffer window (@code{gnus-summary-expand-window}).
+If given a prefix, force an @code{article} window configuration.
+
+@end table
+
+
+@node Exiting the Summary Buffer
+@section Exiting the Summary Buffer
+@cindex summary exit
+@cindex exiting groups
+
+Exiting from the summary buffer will normally update all info on the
+group and return you to the group buffer.
+
+@table @kbd
+
+@item Z Z
+@itemx q
+@kindex Z Z (Summary)
+@kindex q (Summary)
+@findex gnus-summary-exit
+@vindex gnus-summary-exit-hook
+@vindex gnus-summary-prepare-exit-hook
+@c @icon{gnus-summary-exit}
+Exit the current group and update all information on the group
+(@code{gnus-summary-exit}). @code{gnus-summary-prepare-exit-hook} is
+called before doing much of the exiting, which calls
+@code{gnus-summary-expire-articles} by default.
+@code{gnus-summary-exit-hook} is called after finishing the exit
+process. @code{gnus-group-no-more-groups-hook} is run when returning to
+group mode having no more (unread) groups.
+
+@item Z E
+@itemx Q
+@kindex Z E (Summary)
+@kindex Q (Summary)
+@findex gnus-summary-exit-no-update
+Exit the current group without updating any information on the group
+(@code{gnus-summary-exit-no-update}).
+
+@item Z c
+@itemx c
+@kindex Z c (Summary)
+@kindex c (Summary)
+@findex gnus-summary-catchup-and-exit
+@c @icon{gnus-summary-catchup-and-exit}
+Mark all unticked articles in the group as read and then exit
+(@code{gnus-summary-catchup-and-exit}).
+
+@item Z C
+@kindex Z C (Summary)
+@findex gnus-summary-catchup-all-and-exit
+Mark all articles, even the ticked ones, as read and then exit
+(@code{gnus-summary-catchup-all-and-exit}).
+
+@item Z n
+@kindex Z n (Summary)
+@findex gnus-summary-catchup-and-goto-next-group
+Mark all articles as read and go to the next group
+(@code{gnus-summary-catchup-and-goto-next-group}).
+
+@item Z R
+@kindex Z R (Summary)
+@findex gnus-summary-reselect-current-group
+Exit this group, and then enter it again
+(@code{gnus-summary-reselect-current-group}). If given a prefix, select
+all articles, both read and unread.
+
+@item Z G
+@itemx M-g
+@kindex Z G (Summary)
+@kindex M-g (Summary)
+@findex gnus-summary-rescan-group
+@c @icon{gnus-summary-mail-get}
+Exit the group, check for new articles in the group, and select the
+group (@code{gnus-summary-rescan-group}). If given a prefix, select all
+articles, both read and unread.
+
+@item Z N
+@kindex Z N (Summary)
+@findex gnus-summary-next-group
+Exit the group and go to the next group
+(@code{gnus-summary-next-group}).
+
+@item Z P
+@kindex Z P (Summary)
+@findex gnus-summary-prev-group
+Exit the group and go to the previous group
+(@code{gnus-summary-prev-group}).
+
+@item Z s
+@kindex Z s (Summary)
+@findex gnus-summary-save-newsrc
+Save the current number of read/marked articles in the dribble buffer
+and then save the dribble buffer (@code{gnus-summary-save-newsrc}). If
+given a prefix, also save the @file{.newsrc} file(s). Using this
+command will make exit without updating (the @kbd{Q} command) worthless.
+@end table
+
+@vindex gnus-exit-group-hook
+@code{gnus-exit-group-hook} is called when you exit the current
+group.
+
+@findex gnus-summary-wake-up-the-dead
+@findex gnus-dead-summary-mode
+@vindex gnus-kill-summary-on-exit
+If you're in the habit of exiting groups, and then changing your mind
+about it, you might set @code{gnus-kill-summary-on-exit} to @code{nil}.
+If you do that, Gnus won't kill the summary buffer when you exit it.
+(Quelle surprise!) Instead it will change the name of the buffer to
+something like @samp{*Dead Summary ... *} and install a minor mode
+called @code{gnus-dead-summary-mode}. Now, if you switch back to this
+buffer, you'll find that all keys are mapped to a function called
+@code{gnus-summary-wake-up-the-dead}. So tapping any keys in a dead
+summary buffer will result in a live, normal summary buffer.
+
+There will never be more than one dead summary buffer at any one time.
+
+@vindex gnus-use-cross-reference
+The data on the current group will be updated (which articles you have
+read, which articles you have replied to, etc.) when you exit the
+summary buffer. If the @code{gnus-use-cross-reference} variable is
+@code{t} (which is the default), articles that are cross-referenced to
+this group and are marked as read, will also be marked as read in the
+other subscribed groups they were cross-posted to. If this variable is
+neither @code{nil} nor @code{t}, the article will be marked as read in
+both subscribed and unsubscribed groups (@pxref{Crosspost Handling}).
+
+
+@node Crosspost Handling
+@section Crosspost Handling
+
+@cindex velveeta
+@cindex spamming
+Marking cross-posted articles as read ensures that you'll never have to
+read the same article more than once. Unless, of course, somebody has
+posted it to several groups separately. Posting the same article to
+several groups (not cross-posting) is called @dfn{spamming}, and you are
+by law required to send nasty-grams to anyone who perpetrates such a
+heinous crime. You may want to try NoCeM handling to filter out spam
+(@pxref{NoCeM}).
+
+Remember: Cross-posting is kinda ok, but posting the same article
+separately to several groups is not. Massive cross-posting (aka.
+@dfn{velveeta}) is to be avoided at all costs, and you can even use the
+@code{gnus-summary-mail-crosspost-complaint} command to complain about
+excessive crossposting (@pxref{Summary Mail Commands}).
+
+@cindex cross-posting
+@cindex Xref
+@cindex @sc{nov}
+One thing that may cause Gnus to not do the cross-posting thing
+correctly is if you use an @sc{nntp} server that supports @sc{xover}
+(which is very nice, because it speeds things up considerably) which
+does not include the @code{Xref} header in its @sc{nov} lines. This is
+Evil, but all too common, alas, alack. Gnus tries to Do The Right Thing
+even with @sc{xover} by registering the @code{Xref} lines of all
+articles you actually read, but if you kill the articles, or just mark
+them as read without reading them, Gnus will not get a chance to snoop
+the @code{Xref} lines out of these articles, and will be unable to use
+the cross reference mechanism.
+
+@cindex LIST overview.fmt
+@cindex overview.fmt
+To check whether your @sc{nntp} server includes the @code{Xref} header
+in its overview files, try @samp{telnet your.nntp.server nntp},
+@samp{MODE READER} on @code{inn} servers, and then say @samp{LIST
+overview.fmt}. This may not work, but if it does, and the last line you
+get does not read @samp{Xref:full}, then you should shout and whine at
+your news admin until she includes the @code{Xref} header in the
+overview files.
+
+@vindex gnus-nov-is-evil
+If you want Gnus to get the @code{Xref}s right all the time, you have to
+set @code{gnus-nov-is-evil} to @code{t}, which slows things down
+considerably.
+
+C'est la vie.
+
+For an alternative approach, @pxref{Duplicate Suppression}.
+
+
+@node Duplicate Suppression
+@section Duplicate Suppression
+
+By default, Gnus tries to make sure that you don't have to read the same
+article more than once by utilizing the crossposting mechanism
+(@pxref{Crosspost Handling}). However, that simple and efficient
+approach may not work satisfactory for some users for various
+reasons.
+
+@enumerate
+@item
+The @sc{nntp} server may fail to generate the @code{Xref} header. This
+is evil and not very common.
+
+@item
+The @sc{nntp} server may fail to include the @code{Xref} header in the
+@file{.overview} data bases. This is evil and all too common, alas.
+
+@item
+You may be reading the same group (or several related groups) from
+different @sc{nntp} servers.
+
+@item
+You may be getting mail that duplicates articles posted to groups.
+@end enumerate
+
+I'm sure there are other situations where @code{Xref} handling fails as
+well, but these four are the most common situations.
+
+If, and only if, @code{Xref} handling fails for you, then you may
+consider switching on @dfn{duplicate suppression}. If you do so, Gnus
+will remember the @code{Message-ID}s of all articles you have read or
+otherwise marked as read, and then, as if by magic, mark them as read
+all subsequent times you see them---in @emph{all} groups. Using this
+mechanism is quite likely to be somewhat inefficient, but not overly
+so. It's certainly preferable to reading the same articles more than
+once.
+
+Duplicate suppression is not a very subtle instrument. It's more like a
+sledge hammer than anything else. It works in a very simple
+fashion---if you have marked an article as read, it adds this Message-ID
+to a cache. The next time it sees this Message-ID, it will mark the
+article as read with the @samp{M} mark. It doesn't care what group it
+saw the article in.
+
+@table @code
+@item gnus-suppress-duplicates
+@vindex gnus-suppress-duplicates
+If non-@code{nil}, suppress duplicates.
+
+@item gnus-save-duplicate-list
+@vindex gnus-save-duplicate-list
+If non-@code{nil}, save the list of duplicates to a file. This will
+make startup and shutdown take longer, so the default is @code{nil}.
+However, this means that only duplicate articles read in a single Gnus
+session are suppressed.
+
+@item gnus-duplicate-list-length
+@vindex gnus-duplicate-list-length
+This variable says how many @code{Message-ID}s to keep in the duplicate
+suppression list. The default is 10000.
+
+@item gnus-duplicate-file
+@vindex gnus-duplicate-file
+The name of the file to store the duplicate suppression list in. The
+default is @file{~/News/suppression}.
+@end table
+
+If you have a tendency to stop and start Gnus often, setting
+@code{gnus-save-duplicate-list} to @code{t} is probably a good idea. If
+you leave Gnus running for weeks on end, you may have it @code{nil}. On
+the other hand, saving the list makes startup and shutdown much slower,
+so that means that if you stop and start Gnus often, you should set
+@code{gnus-save-duplicate-list} to @code{nil}. Uhm. I'll leave this up
+to you to figure out, I think.
+
+
+@node The Article Buffer
+@chapter The Article Buffer
+@cindex article buffer
+
+The articles are displayed in the article buffer, of which there is only
+one. All the summary buffers share the same article buffer unless you
+tell Gnus otherwise.
+
+@menu
+* Hiding Headers:: Deciding what headers should be displayed.
+* Using MIME:: Pushing articles through @sc{mime} before reading them.
+* Customizing Articles:: Tailoring the look of the articles.
+* Article Keymap:: Keystrokes available in the article buffer.
+* Misc Article:: Other stuff.
+@end menu
+
+
+@node Hiding Headers
+@section Hiding Headers
+@cindex hiding headers
+@cindex deleting headers
+
+The top section of each article is the @dfn{head}. (The rest is the
+@dfn{body}, but you may have guessed that already.)
+
+@vindex gnus-show-all-headers
+There is a lot of useful information in the head: the name of the person
+who wrote the article, the date it was written and the subject of the
+article. That's well and nice, but there's also lots of information
+most people do not want to see---what systems the article has passed
+through before reaching you, the @code{Message-ID}, the
+@code{References}, etc. ad nauseum---and you'll probably want to get rid
+of some of those lines. If you want to keep all those lines in the
+article buffer, you can set @code{gnus-show-all-headers} to @code{t}.
+
+Gnus provides you with two variables for sifting headers:
+
+@table @code
+
+@item gnus-visible-headers
+@vindex gnus-visible-headers
+If this variable is non-@code{nil}, it should be a regular expression
+that says what headers you wish to keep in the article buffer. All
+headers that do not match this variable will be hidden.
+
+For instance, if you only want to see the name of the person who wrote
+the article and the subject, you'd say:
+
+@lisp
+(setq gnus-visible-headers "^From:\\|^Subject:")
+@end lisp
+
+This variable can also be a list of regexps to match headers to
+remain visible.
+
+@item gnus-ignored-headers
+@vindex gnus-ignored-headers
+This variable is the reverse of @code{gnus-visible-headers}. If this
+variable is set (and @code{gnus-visible-headers} is @code{nil}), it
+should be a regular expression that matches all lines that you want to
+hide. All lines that do not match this variable will remain visible.
+
+For instance, if you just want to get rid of the @code{References} line
+and the @code{Xref} line, you might say:
+
+@lisp
+(setq gnus-ignored-headers "^References:\\|^Xref:")
+@end lisp
+
+This variable can also be a list of regexps to match headers to
+be removed.
+
+Note that if @code{gnus-visible-headers} is non-@code{nil}, this
+variable will have no effect.
+
+@end table
+
+@vindex gnus-sorted-header-list
+Gnus can also sort the headers for you. (It does this by default.) You
+can control the sorting by setting the @code{gnus-sorted-header-list}
+variable. It is a list of regular expressions that says in what order
+the headers are to be displayed.
+
+For instance, if you want the name of the author of the article first,
+and then the subject, you might say something like:
+
+@lisp
+(setq gnus-sorted-header-list '("^From:" "^Subject:"))
+@end lisp
+
+Any headers that are to remain visible, but are not listed in this
+variable, will be displayed in random order after all the headers listed in this variable.
+
+@findex gnus-article-hide-boring-headers
+@vindex gnus-article-display-hook
+@vindex gnus-boring-article-headers
+You can hide further boring headers by entering
+@code{gnus-article-hide-boring-headers} into
+@code{gnus-article-display-hook}. What this function does depends on
+the @code{gnus-boring-article-headers} variable. It's a list, but this
+list doesn't actually contain header names. Instead is lists various
+@dfn{boring conditions} that Gnus can check and remove from sight.
+
+These conditions are:
+@table @code
+@item empty
+Remove all empty headers.
+@item newsgroups
+Remove the @code{Newsgroups} header if it only contains the current group
+name.
+@item followup-to
+Remove the @code{Followup-To} header if it is identical to the
+@code{Newsgroups} header.
+@item reply-to
+Remove the @code{Reply-To} header if it lists the same address as the
+@code{From} header.
+@item date
+Remove the @code{Date} header if the article is less than three days
+old.
+@item long-to
+Remove the @code{To} header if it is very long.
+@end table
+
+To include the four first elements, you could say something like;
+
+@lisp
+(setq gnus-boring-article-headers
+ '(empty newsgroups followup-to reply-to))
+@end lisp
+
+This is also the default value for this variable.
+
+
+@node Using MIME
+@section Using @sc{mime}
+@cindex @sc{mime}
+
+Mime is a standard for waving your hands through the air, aimlessly,
+while people stand around yawning.
+
+@sc{mime}, however, is a standard for encoding your articles, aimlessly,
+while all newsreaders die of fear.
+
+@sc{mime} may specify what character set the article uses, the encoding
+of the characters, and it also makes it possible to embed pictures and
+other naughty stuff in innocent-looking articles.
+
+@vindex gnus-show-mime
+@vindex gnus-show-mime-method
+@vindex gnus-strict-mime
+@findex metamail-buffer
+Gnus handles @sc{mime} by pushing the articles through
+@code{gnus-show-mime-method}, which is @code{metamail-buffer} by
+default. Set @code{gnus-show-mime} to @code{t} if you want to use
+@sc{mime} all the time. However, if @code{gnus-strict-mime} is
+non-@code{nil}, the @sc{mime} method will only be used if there are
+@sc{mime} headers in the article. If you have @code{gnus-show-mime}
+set, then you'll see some unfortunate display glitches in the article
+buffer. These can't be avoided.
+
+It might be best to just use the toggling functions from the summary
+buffer to avoid getting nasty surprises. (For instance, you enter the
+group @samp{alt.sing-a-long} and, before you know it, @sc{mime} has
+decoded the sound file in the article and some horrible sing-a-long song
+comes screaming out your speakers, and you can't find the volume
+button, because there isn't one, and people are starting to look at you,
+and you try to stop the program, but you can't, and you can't find the
+program to control the volume, and everybody else in the room suddenly
+decides to look at you disdainfully, and you'll feel rather stupid.)
+
+Any similarity to real events and people is purely coincidental. Ahem.
+
+
+@node Customizing Articles
+@section Customizing Articles
+@cindex article customization
+
+@vindex gnus-article-display-hook
+The @code{gnus-article-display-hook} is called after the article has
+been inserted into the article buffer. It is meant to handle all
+treatment of the article before it is displayed.
+
+@findex gnus-article-maybe-highlight
+By default this hook just contains @code{gnus-article-hide-headers},
+@code{gnus-article-treat-overstrike}, and
+@code{gnus-article-maybe-highlight}, but there are thousands, nay
+millions, of functions you can put in this hook. For an overview of
+functions @pxref{Article Highlighting}, @pxref{Article Hiding},
+@pxref{Article Washing}, @pxref{Article Buttons} and @pxref{Article
+Date}. Note that the order of functions in this hook might affect
+things, so you may have to fiddle a bit to get the desired results.
+
+You can, of course, write your own functions. The functions are called
+from the article buffer, and you can do anything you like, pretty much.
+There is no information that you have to keep in the buffer---you can
+change everything. However, you shouldn't delete any headers. Instead
+make them invisible if you want to make them go away.
+
+
+@node Article Keymap
+@section Article Keymap
+
+Most of the keystrokes in the summary buffer can also be used in the
+article buffer. They should behave as if you typed them in the summary
+buffer, which means that you don't actually have to have a summary
+buffer displayed while reading. You can do it all from the article
+buffer.
+
+A few additional keystrokes are available:
+
+@table @kbd
+
+@item SPACE
+@kindex SPACE (Article)
+@findex gnus-article-next-page
+Scroll forwards one page (@code{gnus-article-next-page}).
+
+@item DEL
+@kindex DEL (Article)
+@findex gnus-article-prev-page
+Scroll backwards one page (@code{gnus-article-prev-page}).
+
+@item C-c ^
+@kindex C-c ^ (Article)
+@findex gnus-article-refer-article
+If point is in the neighborhood of a @code{Message-ID} and you press
+@kbd{r}, Gnus will try to get that article from the server
+(@code{gnus-article-refer-article}).
+
+@item C-c C-m
+@kindex C-c C-m (Article)
+@findex gnus-article-mail
+Send a reply to the address near point (@code{gnus-article-mail}). If
+given a prefix, include the mail.
+
+@item s
+@kindex s (Article)
+@findex gnus-article-show-summary
+Reconfigure the buffers so that the summary buffer becomes visible
+(@code{gnus-article-show-summary}).
+
+@item ?
+@kindex ? (Article)
+@findex gnus-article-describe-briefly
+Give a very brief description of the available keystrokes
+(@code{gnus-article-describe-briefly}).
+
+@item TAB
+@kindex TAB (Article)
+@findex gnus-article-next-button
+Go to the next button, if any (@code{gnus-article-next-button}). This
+only makes sense if you have buttonizing turned on.
+
+@item M-TAB
+@kindex M-TAB (Article)
+@findex gnus-article-prev-button
+Go to the previous button, if any (@code{gnus-article-prev-button}).
+
+@end table
+
+
+@node Misc Article
+@section Misc Article
+
+@table @code
+
+@item gnus-single-article-buffer
+@vindex gnus-single-article-buffer
+If non-@code{nil}, use the same article buffer for all the groups.
+(This is the default.) If @code{nil}, each group will have its own
+article buffer.
+
+@vindex gnus-article-prepare-hook
+@item gnus-article-prepare-hook
+This hook is called right after the article has been inserted into the
+article buffer. It is mainly intended for functions that do something
+depending on the contents; it should probably not be used for changing
+the contents of the article buffer.
+
+@vindex gnus-article-display-hook
+@item gnus-article-display-hook
+This hook is called as the last thing when displaying an article, and is
+intended for modifying the contents of the buffer, doing highlights,
+hiding headers, and the like.
+
+@item gnus-article-mode-hook
+@vindex gnus-article-mode-hook
+Hook called in article mode buffers.
+
+@item gnus-article-mode-syntax-table
+@vindex gnus-article-mode-syntax-table
+Syntax table used in article buffers. It is initialized from
+@code{text-mode-syntax-table}.
+
+@vindex gnus-article-mode-line-format
+@item gnus-article-mode-line-format
+This variable is a format string along the same lines as
+@code{gnus-summary-mode-line-format}. It accepts the same
+format specifications as that variable, with one extension:
+
+@table @samp
+@item w
+The @dfn{wash status} of the article. This is a short string with one
+character for each possible article wash operation that may have been
+performed.
+@end table
+
+@vindex gnus-break-pages
+
+@item gnus-break-pages
+Controls whether @dfn{page breaking} is to take place. If this variable
+is non-@code{nil}, the articles will be divided into pages whenever a
+page delimiter appears in the article. If this variable is @code{nil},
+paging will not be done.
+
+@item gnus-page-delimiter
+@vindex gnus-page-delimiter
+This is the delimiter mentioned above. By default, it is @samp{^L}
+(formfeed).
+@end table
+
+
+@node Composing Messages
+@chapter Composing Messages
+@cindex reply
+@cindex followup
+@cindex post
+
+@kindex C-c C-c (Post)
+All commands for posting and mailing will put you in a message buffer
+where you can edit the article all you like, before you send the article
+by pressing @kbd{C-c C-c}. @xref{Top, , Top, message, The Message
+Manual}. If you are in a foreign news group, and you wish to post the
+article using the foreign server, you can give a prefix to @kbd{C-c C-c}
+to make Gnus try to post using the foreign server.
+
+@menu
+* Mail:: Mailing and replying.
+* Post:: Posting and following up.
+* Posting Server:: What server should you post via?
+* Mail and Post:: Mailing and posting at the same time.
+* Archived Messages:: Where Gnus stores the messages you've sent.
+* Drafts:: Postponing messages and rejected messages.
+* Rejected Articles:: What happens if the server doesn't like your article?
+@end menu
+
+Also see @pxref{Canceling and Superseding} for information on how to
+remove articles you shouldn't have posted.
+
+
+@node Mail
+@section Mail
+
+Variables for customizing outgoing mail:
+
+@table @code
+@item gnus-uu-digest-headers
+@vindex gnus-uu-digest-headers
+List of regexps to match headers included in digested messages. The
+headers will be included in the sequence they are matched.
+
+@item gnus-add-to-list
+@vindex gnus-add-to-list
+If non-@code{nil}, add a @code{to-list} group parameter to mail groups
+that have none when you do a @kbd{a}.
+
+@end table
+
+
+@node Post
+@section Post
+
+Variables for composing news articles:
+
+@table @code
+@item gnus-sent-message-ids-file
+@vindex gnus-sent-message-ids-file
+Gnus will keep a @code{Message-ID} history file of all the mails it has
+sent. If it discovers that it has already sent a mail, it will ask the
+user whether to re-send the mail. (This is primarily useful when
+dealing with @sc{soup} packets and the like where one is apt to send the
+same packet multiple times.) This variable says what the name of this
+history file is. It is @file{~/News/Sent-Message-IDs} by default. Set
+this variable to @code{nil} if you don't want Gnus to keep a history
+file.
+
+@item gnus-sent-message-ids-length
+@vindex gnus-sent-message-ids-length
+This variable says how many @code{Message-ID}s to keep in the history
+file. It is 1000 by default.
+
+@end table
+
+
+@node Posting Server
+@section Posting Server
+
+When you press those magical @kbd{C-c C-c} keys to ship off your latest
+(extremely intelligent, of course) article, where does it go?
+
+Thank you for asking. I hate you.
+
+@vindex gnus-post-method
+
+It can be quite complicated. Normally, Gnus will use the same native
+server. However. If your native server doesn't allow posting, just
+reading, you probably want to use some other server to post your
+(extremely intelligent and fabulously interesting) articles. You can
+then set the @code{gnus-post-method} to some other method:
+
+@lisp
+(setq gnus-post-method '(nnspool ""))
+@end lisp
+
+Now, if you've done this, and then this server rejects your article, or
+this server is down, what do you do then? To override this variable you
+can use a non-zero prefix to the @kbd{C-c C-c} command to force using
+the ``current'' server for posting.
+
+If you give a zero prefix (i.e., @kbd{C-u 0 C-c C-c}) to that command,
+Gnus will prompt you for what method to use for posting.
+
+You can also set @code{gnus-post-method} to a list of select methods.
+If that's the case, Gnus will always prompt you for what method to use
+for posting.
+
+
+@node Mail and Post
+@section Mail and Post
+
+Here's a list of variables relevant to both mailing and
+posting:
+
+@table @code
+@item gnus-mailing-list-groups
+@findex gnus-mailing-list-groups
+@cindex mailing lists
+
+If your news server offers groups that are really mailing lists
+gatewayed to the @sc{nntp} server, you can read those groups without
+problems, but you can't post/followup to them without some difficulty.
+One solution is to add a @code{to-address} to the group parameters
+(@pxref{Group Parameters}). An easier thing to do is set the
+@code{gnus-mailing-list-groups} to a regexp that matches the groups that
+really are mailing lists. Then, at least, followups to the mailing
+lists will work most of the time. Posting to these groups (@kbd{a}) is
+still a pain, though.
+
+@end table
+
+You may want to do spell-checking on messages that you send out. Or, if
+you don't want to spell-check by hand, you could add automatic
+spell-checking via the @code{ispell} package:
+
+@cindex ispell
+@findex ispell-message
+@lisp
+(add-hook 'message-send-hook 'ispell-message)
+@end lisp
+
+
+@node Archived Messages
+@section Archived Messages
+@cindex archived messages
+@cindex sent messages
+
+Gnus provides a few different methods for storing the mail and news you
+send. The default method is to use the @dfn{archive virtual server} to
+store the messages. If you want to disable this completely, the
+@code{gnus-message-archive-group} variable should be @code{nil}, which
+is the default.
+
+@vindex gnus-message-archive-method
+@code{gnus-message-archive-method} says what virtual server Gnus is to
+use to store sent messages. The default is:
+
+@lisp
+(nnfolder "archive"
+ (nnfolder-directory "~/Mail/archive/"))
+@end lisp
+
+You can, however, use any mail select method (@code{nnml},
+@code{nnmbox}, etc.). @code{nnfolder} is a quite likeable select method
+for doing this sort of thing, though. If you don't like the default
+directory chosen, you could say something like:
+
+@lisp
+(setq gnus-message-archive-method
+ '(nnfolder "archive"
+ (nnfolder-inhibit-expiry t)
+ (nnfolder-active-file "~/News/sent-mail/active")
+ (nnfolder-directory "~/News/sent-mail/")))
+@end lisp
+
+@vindex gnus-message-archive-group
+@cindex Gcc
+Gnus will insert @code{Gcc} headers in all outgoing messages that point
+to one or more group(s) on that server. Which group to use is
+determined by the @code{gnus-message-archive-group} variable.
+
+This variable can be used to do the following:
+
+@itemize @bullet
+@item a string
+Messages will be saved in that group.
+@item a list of strings
+Messages will be saved in all those groups.
+@item an alist of regexps, functions and forms
+When a key ``matches'', the result is used.
+@item @code{nil}
+No message archiving will take place. This is the default.
+@end itemize
+
+Let's illustrate:
+
+Just saving to a single group called @samp{MisK}:
+@lisp
+(setq gnus-message-archive-group "MisK")
+@end lisp
+
+Saving to two groups, @samp{MisK} and @samp{safe}:
+@lisp
+(setq gnus-message-archive-group '("MisK" "safe"))
+@end lisp
+
+Save to different groups based on what group you are in:
+@lisp
+(setq gnus-message-archive-group
+ '(("^alt" "sent-to-alt")
+ ("mail" "sent-to-mail")
+ (".*" "sent-to-misc")))
+@end lisp
+
+More complex stuff:
+@lisp
+(setq gnus-message-archive-group
+ '((if (message-news-p)
+ "misc-news"
+ "misc-mail")))
+@end lisp
+
+How about storing all news messages in one file, but storing all mail
+messages in one file per month:
+
+@lisp
+(setq gnus-message-archive-group
+ '((if (message-news-p)
+ "misc-news"
+ (concat "mail." (format-time-string
+ "%Y-%m" (current-time))))))
+@end lisp
+
+(XEmacs 19.13 doesn't have @code{format-time-string}, so you'll have to
+use a different value for @code{gnus-message-archive-group} there.)
+
+Now, when you send a message off, it will be stored in the appropriate
+group. (If you want to disable storing for just one particular message,
+you can just remove the @code{Gcc} header that has been inserted.) The
+archive group will appear in the group buffer the next time you start
+Gnus, or the next time you press @kbd{F} in the group buffer. You can
+enter it and read the articles in it just like you'd read any other
+group. If the group gets really big and annoying, you can simply rename
+if (using @kbd{G r} in the group buffer) to something
+nice---@samp{misc-mail-september-1995}, or whatever. New messages will
+continue to be stored in the old (now empty) group.
+
+That's the default method of archiving sent messages. Gnus offers a
+different way for the people who don't like the default method. In that
+case you should set @code{gnus-message-archive-group} to @code{nil};
+this will disable archiving.
+
+@table @code
+@item gnus-outgoing-message-group
+@vindex gnus-outgoing-message-group
+All outgoing messages will be put in this group. If you want to store
+all your outgoing mail and articles in the group @samp{nnml:archive},
+you set this variable to that value. This variable can also be a list of
+group names.
+
+If you want to have greater control over what group to put each
+message in, you can set this variable to a function that checks the
+current newsgroup name and then returns a suitable group name (or list
+of names).
+
+This variable can be used instead of @code{gnus-message-archive-group},
+but the latter is the preferred method.
+@end table
+
+
+@c @node Posting Styles
+@c @section Posting Styles
+@c @cindex posting styles
+@c @cindex styles
+@c
+@c All them variables, they make my head swim.
+@c
+@c So what if you want a different @code{Organization} and signature based
+@c on what groups you post to? And you post both from your home machine
+@c and your work machine, and you want different @code{From} lines, and so
+@c on?
+@c
+@c @vindex gnus-posting-styles
+@c One way to do stuff like that is to write clever hooks that change the
+@c variables you need to have changed. That's a bit boring, so somebody
+@c came up with the bright idea of letting the user specify these things in
+@c a handy alist. Here's an example of a @code{gnus-posting-styles}
+@c variable:
+@c
+@c @lisp
+@c ((".*"
+@c (signature . "Peace and happiness")
+@c (organization . "What me?"))
+@c ("^comp"
+@c (signature . "Death to everybody"))
+@c ("comp.emacs.i-love-it"
+@c (organization . "Emacs is it")))
+@c @end lisp
+@c
+@c As you might surmise from this example, this alist consists of several
+@c @dfn{styles}. Each style will be applicable if the first element
+@c ``matches'', in some form or other. The entire alist will be iterated
+@c over, from the beginning towards the end, and each match will be
+@c applied, which means that attributes in later styles that match override
+@c the same attributes in earlier matching styles. So
+@c @samp{comp.programming.literate} will have the @samp{Death to everybody}
+@c signature and the @samp{What me?} @code{Organization} header.
+@c
+@c The first element in each style is called the @code{match}. If it's a
+@c string, then Gnus will try to regexp match it against the group name.
+@c If it's a function symbol, that function will be called with no
+@c arguments. If it's a variable symbol, then the variable will be
+@c referenced. If it's a list, then that list will be @code{eval}ed. In
+@c any case, if this returns a non-@code{nil} value, then the style is said
+@c to @dfn{match}.
+@c
+@c Each style may contain a arbitrary amount of @dfn{attributes}. Each
+@c attribute consists of a @var{(name . value)} pair. The attribute name
+@c can be one of @code{signature}, @code{organization} or @code{from}. The
+@c attribute name can also be a string. In that case, this will be used as
+@c a header name, and the value will be inserted in the headers of the
+@c article.
+@c
+@c The attribute value can be a string (used verbatim), a function (the
+@c return value will be used), a variable (its value will be used) or a
+@c list (it will be @code{eval}ed and the return value will be used).
+@c
+@c So here's a new example:
+@c
+@c @lisp
+@c (setq gnus-posting-styles
+@c '((".*"
+@c (signature . "~/.signature")
+@c (from . "user@@foo (user)")
+@c ("X-Home-Page" . (getenv "WWW_HOME"))
+@c (organization . "People's Front Against MWM"))
+@c ("^rec.humor"
+@c (signature . my-funny-signature-randomizer))
+@c ((equal (system-name) "gnarly")
+@c (signature . my-quote-randomizer))
+@c (posting-from-work-p
+@c (signature . "~/.work-signature")
+@c (from . "user@@bar.foo (user)")
+@c (organization . "Important Work, Inc"))
+@c ("^nn.+:"
+@c (signature . "~/.mail-signature"))))
+@c @end lisp
+
+@node Drafts
+@section Drafts
+@cindex drafts
+
+If you are writing a message (mail or news) and suddenly remember that
+you have a steak in the oven (or some pesto in the food processor, you
+craaazy vegetarians), you'll probably wish there was a method to save
+the message you are writing so that you can continue editing it some
+other day, and send it when you feel its finished.
+
+Well, don't worry about it. Whenever you start composing a message of
+some sort using the Gnus mail and post commands, the buffer you get will
+automatically associate to an article in a special @dfn{draft} group.
+If you save the buffer the normal way (@kbd{C-x C-s}, for instance), the
+article will be saved there. (Auto-save files also go to the draft
+group.)
+
+@cindex nndraft
+@vindex nndraft-directory
+The draft group is a special group (which is implemented as an
+@code{nndraft} group, if you absolutely have to know) called
+@samp{nndraft:drafts}. The variable @code{nndraft-directory} says where
+@code{nndraft} is to store its files. What makes this group special is
+that you can't tick any articles in it or mark any articles as
+read---all articles in the group are permanently unread.
+
+If the group doesn't exist, it will be created and you'll be subscribed
+to it. The only way to make it disappear from the Group buffer is to
+unsubscribe it.
+
+@c @findex gnus-dissociate-buffer-from-draft
+@c @kindex C-c M-d (Mail)
+@c @kindex C-c M-d (Post)
+@c @findex gnus-associate-buffer-with-draft
+@c @kindex C-c C-d (Mail)
+@c @kindex C-c C-d (Post)
+@c If you're writing some super-secret message that you later want to
+@c encode with PGP before sending, you may wish to turn the auto-saving
+@c (and association with the draft group) off. You never know who might be
+@c interested in reading all your extremely valuable and terribly horrible
+@c and interesting secrets. The @kbd{C-c M-d}
+@c (@code{gnus-dissociate-buffer-from-draft}) command does that for you.
+@c If you change your mind and want to turn the auto-saving back on again,
+@c @kbd{C-c C-d} (@code{gnus-associate-buffer-with-draft} does that.
+@c
+@c @vindex gnus-use-draft
+@c To leave association with the draft group off by default, set
+@c @code{gnus-use-draft} to @code{nil}. It is @code{t} by default.
+
+@findex gnus-draft-edit-message
+@kindex D e (Draft)
+When you want to continue editing the article, you simply enter the
+draft group and push @kbd{D e} (@code{gnus-draft-edit-message}) to do
+that. You will be placed in a buffer where you left off.
+
+Rejected articles will also be put in this draft group (@pxref{Rejected
+Articles}).
+
+@findex gnus-draft-send-all-messages
+@findex gnus-draft-send-message
+If you have lots of rejected messages you want to post (or mail) without
+doing further editing, you can use the @kbd{D s} command
+(@code{gnus-draft-send-message}). This command understands the
+process/prefix convention (@pxref{Process/Prefix}). The @kbd{D S}
+command (@code{gnus-draft-send-all-messages}) will ship off all messages
+in the buffer.
+
+If you have some messages that you wish not to send, you can use the
+@kbd{D t} (@code{gnus-draft-toggle-sending}) command to mark the message
+as unsendable. This is a toggling command.
+
+
+@node Rejected Articles
+@section Rejected Articles
+@cindex rejected articles
+
+Sometimes a news server will reject an article. Perhaps the server
+doesn't like your face. Perhaps it just feels miserable. Perhaps
+@emph{there be demons}. Perhaps you have included too much cited text.
+Perhaps the disk is full. Perhaps the server is down.
+
+These situations are, of course, totally beyond the control of Gnus.
+(Gnus, of course, loves the way you look, always feels great, has angels
+fluttering around inside of it, doesn't care about how much cited text
+you include, never runs full and never goes down.) So Gnus saves these
+articles until some later time when the server feels better.
+
+The rejected articles will automatically be put in a special draft group
+(@pxref{Drafts}). When the server comes back up again, you'd then
+typically enter that group and send all the articles off.
+
+
+@node Select Methods
+@chapter Select Methods
+@cindex foreign groups
+@cindex select methods
+
+A @dfn{foreign group} is a group not read by the usual (or
+default) means. It could be, for instance, a group from a different
+@sc{nntp} server, it could be a virtual group, or it could be your own
+personal mail group.
+
+A foreign group (or any group, really) is specified by a @dfn{name} and
+a @dfn{select method}. To take the latter first, a select method is a
+list where the first element says what backend to use (e.g. @code{nntp},
+@code{nnspool}, @code{nnml}) and the second element is the @dfn{server
+name}. There may be additional elements in the select method, where the
+value may have special meaning for the backend in question.
+
+One could say that a select method defines a @dfn{virtual server}---so
+we do just that (@pxref{The Server Buffer}).
+
+The @dfn{name} of the group is the name the backend will recognize the
+group as.
+
+For instance, the group @samp{soc.motss} on the @sc{nntp} server
+@samp{some.where.edu} will have the name @samp{soc.motss} and select
+method @code{(nntp "some.where.edu")}. Gnus will call this group
+@samp{nntp+some.where.edu:soc.motss}, even though the @code{nntp}
+backend just knows this group as @samp{soc.motss}.
+
+The different methods all have their peculiarities, of course.
+
+@menu
+* The Server Buffer:: Making and editing virtual servers.
+* Getting News:: Reading USENET news with Gnus.
+* Getting Mail:: Reading your personal mail with Gnus.
+* Other Sources:: Reading directories, files, SOUP packets.
+* Combined Groups:: Combining groups into one group.
+* Gnus Unplugged:: Reading news and mail offline.
+@end menu
+
+
+@node The Server Buffer
+@section The Server Buffer
+
+Traditionally, a @dfn{server} is a machine or a piece of software that
+one connects to, and then requests information from. Gnus does not
+connect directly to any real servers, but does all transactions through
+one backend or other. But that's just putting one layer more between
+the actual media and Gnus, so we might just as well say that each
+backend represents a virtual server.
+
+For instance, the @code{nntp} backend may be used to connect to several
+different actual @sc{nntp} servers, or, perhaps, to many different ports
+on the same actual @sc{nntp} server. You tell Gnus which backend to
+use, and what parameters to set by specifying a @dfn{select method}.
+
+These select method specifications can sometimes become quite
+complicated---say, for instance, that you want to read from the
+@sc{nntp} server @samp{news.funet.fi} on port number 13, which
+hangs if queried for @sc{nov} headers and has a buggy select. Ahem.
+Anyways, if you had to specify that for each group that used this
+server, that would be too much work, so Gnus offers a way of naming
+select methods, which is what you do in the server buffer.
+
+To enter the server buffer, use the @kbd{^}
+(@code{gnus-group-enter-server-mode}) command in the group buffer.
+
+@menu
+* Server Buffer Format:: You can customize the look of this buffer.
+* Server Commands:: Commands to manipulate servers.
+* Example Methods:: Examples server specifications.
+* Creating a Virtual Server:: An example session.
+* Server Variables:: Which variables to set.
+* Servers and Methods:: You can use server names as select methods.
+* Unavailable Servers:: Some servers you try to contact may be down.
+@end menu
+
+@vindex gnus-server-mode-hook
+@code{gnus-server-mode-hook} is run when creating the server buffer.
+
+
+@node Server Buffer Format
+@subsection Server Buffer Format
+@cindex server buffer format
+
+@vindex gnus-server-line-format
+You can change the look of the server buffer lines by changing the
+@code{gnus-server-line-format} variable. This is a @code{format}-like
+variable, with some simple extensions:
+
+@table @samp
+
+@item h
+How the news is fetched---the backend name.
+
+@item n
+The name of this server.
+
+@item w
+Where the news is to be fetched from---the address.
+
+@item s
+The opened/closed/denied status of the server.
+@end table
+
+@vindex gnus-server-mode-line-format
+The mode line can also be customized by using the
+@code{gnus-server-mode-line-format} variable. The following specs are
+understood:
+
+@table @samp
+@item S
+Server name.
+
+@item M
+Server method.
+@end table
+
+Also @pxref{Formatting Variables}.
+
+
+@node Server Commands
+@subsection Server Commands
+@cindex server commands
+
+@table @kbd
+
+@item a
+@kindex a (Server)
+@findex gnus-server-add-server
+Add a new server (@code{gnus-server-add-server}).
+
+@item e
+@kindex e (Server)
+@findex gnus-server-edit-server
+Edit a server (@code{gnus-server-edit-server}).
+
+@item SPACE
+@kindex SPACE (Server)
+@findex gnus-server-read-server
+Browse the current server (@code{gnus-server-read-server}).
+
+@item q
+@kindex q (Server)
+@findex gnus-server-exit
+Return to the group buffer (@code{gnus-server-exit}).
+
+@item k
+@kindex k (Server)
+@findex gnus-server-kill-server
+Kill the current server (@code{gnus-server-kill-server}).
+
+@item y
+@kindex y (Server)
+@findex gnus-server-yank-server
+Yank the previously killed server (@code{gnus-server-yank-server}).
+
+@item c
+@kindex c (Server)
+@findex gnus-server-copy-server
+Copy the current server (@code{gnus-server-copy-server}).
+
+@item l
+@kindex l (Server)
+@findex gnus-server-list-servers
+List all servers (@code{gnus-server-list-servers}).
+
+@item s
+@kindex s (Server)
+@findex gnus-server-scan-server
+Request that the server scan its sources for new articles
+(@code{gnus-server-scan-server}). This is mainly sensible with mail
+servers.
+
+@item g
+@kindex g (Server)
+@findex gnus-server-regenerate-server
+Request that the server regenerate all its data structures
+(@code{gnus-server-regenerate-server}). This can be useful if you have
+a mail backend that has gotten out of synch.
+
+@end table
+
+
+@node Example Methods
+@subsection Example Methods
+
+Most select methods are pretty simple and self-explanatory:
+
+@lisp
+(nntp "news.funet.fi")
+@end lisp
+
+Reading directly from the spool is even simpler:
+
+@lisp
+(nnspool "")
+@end lisp
+
+As you can see, the first element in a select method is the name of the
+backend, and the second is the @dfn{address}, or @dfn{name}, if you
+will.
+
+After these two elements, there may be an arbitrary number of
+@var{(variable form)} pairs.
+
+To go back to the first example---imagine that you want to read from
+port 15 on that machine. This is what the select method should
+look like then:
+
+@lisp
+(nntp "news.funet.fi" (nntp-port-number 15))
+@end lisp
+
+You should read the documentation to each backend to find out what
+variables are relevant, but here's an @code{nnmh} example:
+
+@code{nnmh} is a mail backend that reads a spool-like structure. Say
+you have two structures that you wish to access: One is your private
+mail spool, and the other is a public one. Here's the possible spec for
+your private mail:
+
+@lisp
+(nnmh "private" (nnmh-directory "~/private/mail/"))
+@end lisp
+
+(This server is then called @samp{private}, but you may have guessed
+that.)
+
+Here's the method for a public spool:
+
+@lisp
+(nnmh "public"
+ (nnmh-directory "/usr/information/spool/")
+ (nnmh-get-new-mail nil))
+@end lisp
+
+If you are behind a firewall and only have access to the @sc{nntp}
+server from the firewall machine, you can instruct Gnus to @code{rlogin}
+on the firewall machine and telnet from there to the @sc{nntp} server.
+Doing this can be rather fiddly, but your virtual server definition
+should probably look something like this:
+
+@lisp
+(nntp "firewall"
+ (nntp-address "the.firewall.machine")
+ (nntp-open-connection-function nntp-open-rlogin)
+ (nntp-end-of-line "\n")
+ (nntp-rlogin-parameters
+ ("telnet" "the.real.nntp.host" "nntp")))
+@end lisp
+
+
+
+@node Creating a Virtual Server
+@subsection Creating a Virtual Server
+
+If you're saving lots of articles in the cache by using persistent
+articles, you may want to create a virtual server to read the cache.
+
+First you need to add a new server. The @kbd{a} command does that. It
+would probably be best to use @code{nnspool} to read the cache. You
+could also use @code{nnml} or @code{nnmh}, though.
+
+Type @kbd{a nnspool RET cache RET}.
+
+You should now have a brand new @code{nnspool} virtual server called
+@samp{cache}. You now need to edit it to have the right definitions.
+Type @kbd{e} to edit the server. You'll be entered into a buffer that
+will contain the following:
+
+@lisp
+(nnspool "cache")
+@end lisp
+
+Change that to:
+
+@lisp
+(nnspool "cache"
+ (nnspool-spool-directory "~/News/cache/")
+ (nnspool-nov-directory "~/News/cache/")
+ (nnspool-active-file "~/News/cache/active"))
+@end lisp
+
+Type @kbd{C-c C-c} to return to the server buffer. If you now press
+@kbd{RET} over this virtual server, you should be entered into a browse
+buffer, and you should be able to enter any of the groups displayed.
+
+
+@node Server Variables
+@subsection Server Variables
+
+One sticky point when defining variables (both on backends and in Emacs
+in general) is that some variables are typically initialized from other
+variables when the definition of the variables is being loaded. If you
+change the "base" variable after the variables have been loaded, you
+won't change the "derived" variables.
+
+This typically affects directory and file variables. For instance,
+@code{nnml-directory} is @file{~/Mail/} by default, and all @code{nnml}
+directory variables are initialized from that variable, so
+@code{nnml-active-file} will be @file{~/Mail/active}. If you define a
+new virtual @code{nnml} server, it will @emph{not} suffice to set just
+@code{nnml-directory}---you have to explicitly set all the file
+variables to be what you want them to be. For a complete list of
+variables for each backend, see each backend's section later in this
+manual, but here's an example @code{nnml} definition:
+
+@lisp
+(nnml "public"
+ (nnml-directory "~/my-mail/")
+ (nnml-active-file "~/my-mail/active")
+ (nnml-newsgroups-file "~/my-mail/newsgroups"))
+@end lisp
+
+
+@node Servers and Methods
+@subsection Servers and Methods
+
+Wherever you would normally use a select method
+(e.g. @code{gnus-secondary-select-method}, in the group select method,
+when browsing a foreign server) you can use a virtual server name
+instead. This could potentially save lots of typing. And it's nice all
+over.
+
+
+@node Unavailable Servers
+@subsection Unavailable Servers
+
+If a server seems to be unreachable, Gnus will mark that server as
+@code{denied}. That means that any subsequent attempt to make contact
+with that server will just be ignored. ``It can't be opened,'' Gnus
+will tell you, without making the least effort to see whether that is
+actually the case or not.
+
+That might seem quite naughty, but it does make sense most of the time.
+Let's say you have 10 groups subscribed to on server
+@samp{nephelococcygia.com}. This server is located somewhere quite far
+away from you and the machine is quite slow, so it takes 1 minute just
+to find out that it refuses connection to you today. If Gnus were to
+attempt to do that 10 times, you'd be quite annoyed, so Gnus won't
+attempt to do that. Once it has gotten a single ``connection refused'',
+it will regard that server as ``down''.
+
+So, what happens if the machine was only feeling unwell temporarily?
+How do you test to see whether the machine has come up again?
+
+You jump to the server buffer (@pxref{The Server Buffer}) and poke it
+with the following commands:
+
+@table @kbd
+
+@item O
+@kindex O (Server)
+@findex gnus-server-open-server
+Try to establish connection to the server on the current line
+(@code{gnus-server-open-server}).
+
+@item C
+@kindex C (Server)
+@findex gnus-server-close-server
+Close the connection (if any) to the server
+(@code{gnus-server-close-server}).
+
+@item D
+@kindex D (Server)
+@findex gnus-server-deny-server
+Mark the current server as unreachable
+(@code{gnus-server-deny-server}).
+
+@item M-o
+@kindex M-o (Server)
+@findex gnus-server-open-all-servers
+Open the connections to all servers in the buffer
+(@code{gnus-server-open-all-servers}).
+
+@item M-c
+@kindex M-c (Server)
+@findex gnus-server-close-all-servers
+Close the connections to all servers in the buffer
+(@code{gnus-server-close-all-servers}).
+
+@item R
+@kindex R (Server)
+@findex gnus-server-remove-denials
+Remove all marks to whether Gnus was denied connection from any servers
+(@code{gnus-server-remove-denials}).
+
+@end table
+
+
+@node Getting News
+@section Getting News
+@cindex reading news
+@cindex news backends
+
+A newsreader is normally used for reading news. Gnus currently provides
+only two methods of getting news---it can read from an @sc{nntp} server,
+or it can read from a local spool.
+
+@menu
+* NNTP:: Reading news from an @sc{nntp} server.
+* News Spool:: Reading news from the local spool.
+@end menu
+
+
+@node NNTP
+@subsection @sc{nntp}
+@cindex nntp
+
+Subscribing to a foreign group from an @sc{nntp} server is rather easy.
+You just specify @code{nntp} as method and the address of the @sc{nntp}
+server as the, uhm, address.
+
+If the @sc{nntp} server is located at a non-standard port, setting the
+third element of the select method to this port number should allow you
+to connect to the right port. You'll have to edit the group info for
+that (@pxref{Foreign Groups}).
+
+The name of the foreign group can be the same as a native group. In
+fact, you can subscribe to the same group from as many different servers
+you feel like. There will be no name collisions.
+
+The following variables can be used to create a virtual @code{nntp}
+server:
+
+@table @code
+
+@item nntp-server-opened-hook
+@vindex nntp-server-opened-hook
+@cindex @sc{mode reader}
+@cindex authinfo
+@cindex authentification
+@cindex nntp authentification
+@findex nntp-send-authinfo
+@findex nntp-send-mode-reader
+is run after a connection has been made. It can be used to send
+commands to the @sc{nntp} server after it has been contacted. By
+default it sends the command @code{MODE READER} to the server with the
+@code{nntp-send-mode-reader} function. This function should always be
+present in this hook.
+
+@item nntp-authinfo-function
+@vindex nntp-authinfo-function
+This function will be used to send @samp{AUTHINFO} to the @sc{nntp}
+server. Available functions include:
+
+@table @code
+@item nntp-send-authinfo
+@findex nntp-send-authinfo
+This function will use your current login name as the user name and will
+prompt you for the password. This is the default.
+
+@item nntp-send-nosy-authinfo
+@findex nntp-send-nosy-authinfo
+This function will prompt you for both user name and password.
+
+@item nntp-send-authinfo-from-file
+@findex nntp-send-authinfo-from-file
+This function will use your current login name as the user name and will
+read the @sc{nntp} password from @file{~/.nntp-authinfo}.
+@end table
+
+@item nntp-server-action-alist
+@vindex nntp-server-action-alist
+This is a list of regexps to match on server types and actions to be
+taken when matches are made. For instance, if you want Gnus to beep
+every time you connect to innd, you could say something like:
+
+@lisp
+(setq nntp-server-action-alist
+ '(("innd" (ding))))
+@end lisp
+
+You probably don't want to do that, though.
+
+The default value is
+
+@lisp
+'(("nntpd 1\\.5\\.11t"
+ (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)))
+@end lisp
+
+This ensures that Gnus doesn't send the @code{MODE READER} command to
+nntpd 1.5.11t, since that command chokes that server, I've been told.
+
+@item nntp-maximum-request
+@vindex nntp-maximum-request
+If the @sc{nntp} server doesn't support @sc{nov} headers, this backend
+will collect headers by sending a series of @code{head} commands. To
+speed things up, the backend sends lots of these commands without
+waiting for reply, and then reads all the replies. This is controlled
+by the @code{nntp-maximum-request} variable, and is 400 by default. If
+your network is buggy, you should set this to 1.
+
+@item nntp-connection-timeout
+@vindex nntp-connection-timeout
+If you have lots of foreign @code{nntp} groups that you connect to
+regularly, you're sure to have problems with @sc{nntp} servers not
+responding properly, or being too loaded to reply within reasonable
+time. This is can lead to awkward problems, which can be helped
+somewhat by setting @code{nntp-connection-timeout}. This is an integer
+that says how many seconds the @code{nntp} backend should wait for a
+connection before giving up. If it is @code{nil}, which is the default,
+no timeouts are done.
+
+@item nntp-command-timeout
+@vindex nntp-command-timeout
+@cindex PPP connections
+@cindex dynamic IP addresses
+If you're running Gnus on a machine that has a dynamically assigned
+address, Gnus may become confused. If the address of your machine
+changes after connecting to the @sc{nntp} server, Gnus will simply sit
+waiting forever for replies from the server. To help with this
+unfortunate problem, you can set this command to a number. Gnus will
+then, if it sits waiting for a reply from the server longer than that
+number of seconds, shut down the connection, start a new one, and resend
+the command. This should hopefully be transparent to the user. A
+likely number is 30 seconds.
+
+@item nntp-retry-on-break
+@vindex nntp-retry-on-break
+If this variable is non-@code{nil}, you can also @kbd{C-g} if Gnus
+hangs. This will have much the same effect as the command timeout
+described above.
+
+@item nntp-server-hook
+@vindex nntp-server-hook
+This hook is run as the last step when connecting to an @sc{nntp}
+server.
+
+@findex nntp-open-rlogin
+@findex nntp-open-telnet
+@findex nntp-open-network-stream
+@item nntp-open-connection-function
+@vindex nntp-open-connection-function
+This function is used to connect to the remote system. Three pre-made
+functions are @code{nntp-open-network-stream}, which is the default, and
+simply connects to some port or other on the remote system. The other
+two are @code{nntp-open-rlogin}, which does an @samp{rlogin} on the
+remote system, and then does a @samp{telnet} to the @sc{nntp} server
+available there, and @code{nntp-open-telnet}, which does a @samp{telnet}
+to the remote system and then another @samp{telnet} to get to the
+@sc{nntp} server.
+
+@code{nntp-open-rlogin}-related variables:
+
+@table @code
+
+@item nntp-rlogin-program
+@vindex nntp-rlogin-program
+Program used to log in on remote machines. The default is @samp{rsh},
+but @samp{ssh} is a popular alternative.
+
+@item nntp-rlogin-parameters
+@vindex nntp-rlogin-parameters
+This list will be used as the parameter list given to @code{rsh}.
+
+@item nntp-rlogin-user-name
+@vindex nntp-rlogin-user-name
+User name on the remote system.
+
+@end table
+
+@code{nntp-open-telnet}-related variables:
+
+@table @code
+@item nntp-telnet-command
+@vindex nntp-telnet-command
+Command used to start @code{telnet}.
+
+@item nntp-telnet-switches
+@vindex nntp-telnet-switches
+List of strings to be used as the switches to the @code{telnet} command.
+
+@item nntp-telnet-user-name
+@vindex nntp-telnet-user-name
+User name for log in on the remote system.
+
+@item nntp-telnet-passwd
+@vindex nntp-telnet-passwd
+Password to use when logging in.
+
+@item nntp-telnet-parameters
+@vindex nntp-telnet-parameters
+A list of strings executed as a command after logging in
+via @code{telnet}.
+
+@end table
+
+@item nntp-end-of-line
+@vindex nntp-end-of-line
+String to use as end-of-line marker when talking to the @sc{nntp}
+server. This is @samp{\r\n} by default, but should be @samp{\n} when
+using @code{rlogin} to talk to the server.
+
+@item nntp-rlogin-user-name
+@vindex nntp-rlogin-user-name
+User name on the remote system when using the @code{rlogin} connect
+function.
+
+@item nntp-address
+@vindex nntp-address
+The address of the remote system running the @sc{nntp} server.
+
+@item nntp-port-number
+@vindex nntp-port-number
+Port number to connect to when using the @code{nntp-open-network-stream}
+connect function.
+
+@item nntp-buggy-select
+@vindex nntp-buggy-select
+Set this to non-@code{nil} if your select routine is buggy.
+
+@item nntp-nov-is-evil
+@vindex nntp-nov-is-evil
+If the @sc{nntp} server does not support @sc{nov}, you could set this
+variable to @code{t}, but @code{nntp} usually checks automatically whether @sc{nov}
+can be used.
+
+@item nntp-xover-commands
+@vindex nntp-xover-commands
+@cindex nov
+@cindex XOVER
+List of strings used as commands to fetch @sc{nov} lines from a
+server. The default value of this variable is @code{("XOVER"
+"XOVERVIEW")}.
+
+@item nntp-nov-gap
+@vindex nntp-nov-gap
+@code{nntp} normally sends just one big request for @sc{nov} lines to
+the server. The server responds with one huge list of lines. However,
+if you have read articles 2-5000 in the group, and only want to read
+article 1 and 5001, that means that @code{nntp} will fetch 4999 @sc{nov}
+lines that you will not need. This variable says how
+big a gap between two consecutive articles is allowed to be before the
+@code{XOVER} request is split into several request. Note that if your
+network is fast, setting this variable to a really small number means
+that fetching will probably be slower. If this variable is @code{nil},
+@code{nntp} will never split requests. The default is 5.
+
+@item nntp-prepare-server-hook
+@vindex nntp-prepare-server-hook
+A hook run before attempting to connect to an @sc{nntp} server.
+
+@item nntp-warn-about-losing-connection
+@vindex nntp-warn-about-losing-connection
+If this variable is non-@code{nil}, some noise will be made when a
+server closes connection.
+
+@end table
+
+
+@node News Spool
+@subsection News Spool
+@cindex nnspool
+@cindex news spool
+
+Subscribing to a foreign group from the local spool is extremely easy,
+and might be useful, for instance, to speed up reading groups that
+contain very big articles---@samp{alt.binaries.pictures.furniture}, for
+instance.
+
+Anyways, you just specify @code{nnspool} as the method and @samp{} (or
+anything else) as the address.
+
+If you have access to a local spool, you should probably use that as the
+native select method (@pxref{Finding the News}). It is normally faster
+than using an @code{nntp} select method, but might not be. It depends.
+You just have to try to find out what's best at your site.
+
+@table @code
+
+@item nnspool-inews-program
+@vindex nnspool-inews-program
+Program used to post an article.
+
+@item nnspool-inews-switches
+@vindex nnspool-inews-switches
+Parameters given to the inews program when posting an article.
+
+@item nnspool-spool-directory
+@vindex nnspool-spool-directory
+Where @code{nnspool} looks for the articles. This is normally
+@file{/usr/spool/news/}.
+
+@item nnspool-nov-directory
+@vindex nnspool-nov-directory
+Where @code{nnspool} will look for @sc{nov} files. This is normally
+@file{/usr/spool/news/over.view/}.
+
+@item nnspool-lib-dir
+@vindex nnspool-lib-dir
+Where the news lib dir is (@file{/usr/lib/news/} by default).
+
+@item nnspool-active-file
+@vindex nnspool-active-file
+The path to the active file.
+
+@item nnspool-newsgroups-file
+@vindex nnspool-newsgroups-file
+The path to the group descriptions file.
+
+@item nnspool-history-file
+@vindex nnspool-history-file
+The path to the news history file.
+
+@item nnspool-active-times-file
+@vindex nnspool-active-times-file
+The path to the active date file.
+
+@item nnspool-nov-is-evil
+@vindex nnspool-nov-is-evil
+If non-@code{nil}, @code{nnspool} won't try to use any @sc{nov} files
+that it finds.
+
+@item nnspool-sift-nov-with-sed
+@vindex nnspool-sift-nov-with-sed
+@cindex sed
+If non-@code{nil}, which is the default, use @code{sed} to get the
+relevant portion from the overview file. If nil, @code{nnspool} will
+load the entire file into a buffer and process it there.
+
+@end table
+
+
+@node Getting Mail
+@section Getting Mail
+@cindex reading mail
+@cindex mail
+
+Reading mail with a newsreader---isn't that just plain WeIrD? But of
+course.
+
+@menu
+* Getting Started Reading Mail:: A simple cookbook example.
+* Splitting Mail:: How to create mail groups.
+* Mail Backend Variables:: Variables for customizing mail handling.
+* Fancy Mail Splitting:: Gnus can do hairy splitting of incoming mail.
+* Mail and Procmail:: Reading mail groups that procmail create.
+* Incorporating Old Mail:: What about the old mail you have?
+* Expiring Mail:: Getting rid of unwanted mail.
+* Washing Mail:: Removing gruft from the mail you get.
+* Duplicates:: Dealing with duplicated mail.
+* Not Reading Mail:: Using mail backends for reading other files.
+* Choosing a Mail Backend:: Gnus can read a variety of mail formats.
+@end menu
+
+
+@node Getting Started Reading Mail
+@subsection Getting Started Reading Mail
+
+It's quite easy to use Gnus to read your new mail. You just plonk the
+mail backend of your choice into @code{gnus-secondary-select-methods},
+and things will happen automatically.
+
+For instance, if you want to use @code{nnml} (which is a "one file per
+mail" backend), you could put the following in your @file{.gnus} file:
+
+@lisp
+(setq gnus-secondary-select-methods
+ '((nnml "private")))
+@end lisp
+
+Now, the next time you start Gnus, this backend will be queried for new
+articles, and it will move all the messages in your spool file to its
+directory, which is @code{~/Mail/} by default. The new group that will
+be created (@samp{mail.misc}) will be subscribed, and you can read it
+like any other group.
+
+You will probably want to split the mail into several groups, though:
+
+@lisp
+(setq nnmail-split-methods
+ '(("junk" "^From:.*Lars Ingebrigtsen")
+ ("crazy" "^Subject:.*die\\|^Organization:.*flabby")
+ ("other" "")))
+@end lisp
+
+This will result in three new @code{nnml} mail groups being created:
+@samp{nnml:junk}, @samp{nnml:crazy}, and @samp{nnml:other}. All the
+mail that doesn't fit into the first two groups will be placed in the
+last group.
+
+This should be sufficient for reading mail with Gnus. You might want to
+give the other sections in this part of the manual a perusal, though.
+Especially @pxref{Choosing a Mail Backend} and @pxref{Expiring Mail}.
+
+
+@node Splitting Mail
+@subsection Splitting Mail
+@cindex splitting mail
+@cindex mail splitting
+
+@vindex nnmail-split-methods
+The @code{nnmail-split-methods} variable says how the incoming mail is
+to be split into groups.
+
+@lisp
+(setq nnmail-split-methods
+ '(("mail.junk" "^From:.*Lars Ingebrigtsen")
+ ("mail.crazy" "^Subject:.*die\\|^Organization:.*flabby")
+ ("mail.other" "")))
+@end lisp
+
+This variable is a list of lists, where the first element of each of
+these lists is the name of the mail group (they do not have to be called
+something beginning with @samp{mail}, by the way), and the second
+element is a regular expression used on the header of each mail to
+determine if it belongs in this mail group.
+
+If the first element is the special symbol @code{junk}, then messages
+that match the regexp will disappear into the aether. Use with
+extreme caution.
+
+The second element can also be a function. In that case, it will be
+called narrowed to the headers with the first element of the rule as the
+argument. It should return a non-@code{nil} value if it thinks that the
+mail belongs in that group.
+
+The last of these groups should always be a general one, and the regular
+expression should @emph{always} be @samp{} so that it matches any mails
+that haven't been matched by any of the other regexps. (These rules are
+processed from the beginning of the alist toward the end. The first
+rule to make a match will "win", unless you have crossposting enabled.
+In that case, all matching rules will "win".)
+
+If you like to tinker with this yourself, you can set this variable to a
+function of your choice. This function will be called without any
+arguments in a buffer narrowed to the headers of an incoming mail
+message. The function should return a list of group names that it
+thinks should carry this mail message.
+
+Note that the mail backends are free to maul the poor, innocent,
+incoming headers all they want to. They all add @code{Lines} headers;
+some add @code{X-Gnus-Group} headers; most rename the Unix mbox
+@code{From<SPACE>} line to something else.
+
+@vindex nnmail-crosspost
+The mail backends all support cross-posting. If several regexps match,
+the mail will be ``cross-posted'' to all those groups.
+@code{nnmail-crosspost} says whether to use this mechanism or not. Note
+that no articles are crossposted to the general (@samp{}) group.
+
+@vindex nnmail-crosspost-link-function
+@cindex crosspost
+@cindex links
+@code{nnmh} and @code{nnml} makes crossposts by creating hard links to
+the crossposted articles. However, not all file systems support hard
+links. If that's the case for you, set
+@code{nnmail-crosspost-link-function} to @code{copy-file}. (This
+variable is @code{add-name-to-file} by default.)
+
+@kindex M-x nnmail-split-history
+@kindex nnmail-split-history
+If you wish to see where the previous mail split put the messages, you
+can use the @kbd{M-x nnmail-split-history} command.
+
+Gnus gives you all the opportunity you could possibly want for shooting
+yourself in the foot. Let's say you create a group that will contain
+all the mail you get from your boss. And then you accidentally
+unsubscribe from the group. Gnus will still put all the mail from your
+boss in the unsubscribed group, and so, when your boss mails you ``Have
+that report ready by Monday or you're fired!'', you'll never see it and,
+come Tuesday, you'll still believe that you're gainfully employed while
+you really should be out collecting empty bottles to save up for next
+month's rent money.
+
+
+@node Mail Backend Variables
+@subsection Mail Backend Variables
+
+These variables are (for the most part) pertinent to all the various
+mail backends.
+
+@table @code
+@vindex nnmail-read-incoming-hook
+@item nnmail-read-incoming-hook
+The mail backends all call this hook after reading new mail. You can
+use this hook to notify any mail watch programs, if you want to.
+
+@vindex nnmail-spool-file
+@item nnmail-spool-file
+@cindex POP mail
+@cindex MAILHOST
+@cindex movemail
+@vindex nnmail-pop-password
+@vindex nnmail-pop-password-required
+The backends will look for new mail in this file. If this variable is
+@code{nil}, the mail backends will never attempt to fetch mail by
+themselves. If you are using a POP mail server and your name is
+@samp{larsi}, you should set this variable to @samp{po:larsi}. If
+your name is not @samp{larsi}, you should probably modify that
+slightly, but you may have guessed that already, you smart & handsome
+devil! You can also set this variable to @code{pop}, and Gnus will try
+to figure out the POP mail string by itself. In any case, Gnus will
+call @code{movemail} which will contact the POP server named in the
+@code{MAILHOST} environment variable. If the POP server needs a
+password, you can either set @code{nnmail-pop-password-required} to
+@code{t} and be prompted for the password, or set
+@code{nnmail-pop-password} to the password itself.
+
+@code{nnmail-spool-file} can also be a list of mailboxes.
+
+Your Emacs has to have been configured with @samp{--with-pop} before
+compilation. This is the default, but some installations have it
+switched off.
+
+When you use a mail backend, Gnus will slurp all your mail from your
+inbox and plonk it down in your home directory. Gnus doesn't move any
+mail if you're not using a mail backend---you have to do a lot of magic
+invocations first. At the time when you have finished drawing the
+pentagram, lightened the candles, and sacrificed the goat, you really
+shouldn't be too surprised when Gnus moves your mail.
+
+@vindex nnmail-use-procmail
+@vindex nnmail-procmail-suffix
+@item nnmail-use-procmail
+If non-@code{nil}, the mail backends will look in
+@code{nnmail-procmail-directory} for incoming mail. All the files in
+that directory that have names ending in @code{nnmail-procmail-suffix}
+will be considered incoming mailboxes, and will be searched for new
+mail.
+
+@vindex nnmail-crash-box
+@item nnmail-crash-box
+When a mail backend reads a spool file, mail is first moved to this
+file, which is @file{~/.gnus-crash-box} by default. If this file
+already exists, it will always be read (and incorporated) before any
+other spool files.
+
+@vindex nnmail-prepare-incoming-hook
+@item nnmail-prepare-incoming-hook
+This is run in a buffer that holds all the new incoming mail, and can be
+used for, well, anything, really.
+
+@vindex nnmail-split-hook
+@item nnmail-split-hook
+@findex article-decode-rfc1522
+@findex RFC1522 decoding
+Hook run in the buffer where the mail headers of each message is kept
+just before the splitting based on these headers is done. The hook is
+free to modify the buffer contents in any way it sees fit---the buffer
+is discarded after the splitting has been done, and no changes performed
+in the buffer will show up in any files. @code{gnus-article-decode-rfc1522}
+is one likely function to add to this hook.
+
+@vindex nnmail-pre-get-new-mail-hook
+@vindex nnmail-post-get-new-mail-hook
+@item nnmail-pre-get-new-mail-hook
+@itemx nnmail-post-get-new-mail-hook
+These are two useful hooks executed when treating new incoming
+mail---@code{nnmail-pre-get-new-mail-hook} (is called just before
+starting to handle the new mail) and
+@code{nnmail-post-get-new-mail-hook} (is called when the mail handling
+is done). Here's and example of using these two hooks to change the
+default file modes the new mail files get:
+
+@lisp
+(add-hook 'gnus-pre-get-new-mail-hook
+ (lambda () (set-default-file-modes 511)))
+
+(add-hook 'gnus-post-get-new-mail-hook
+ (lambda () (set-default-file-modes 551)))
+@end lisp
+
+@item nnmail-tmp-directory
+@vindex nnmail-tmp-directory
+This variable says where to move incoming mail to -- while processing
+it. This is usually done in the same directory that the mail backend
+inhabits (e.g., @file{~/Mail/}), but if this variable is non-@code{nil},
+it will be used instead.
+
+@item nnmail-movemail-program
+@vindex nnmail-movemail-program
+This program is executed to move mail from the user's inbox to her home
+directory. The default is @samp{movemail}.
+
+This can also be a function. In that case, the function will be called
+with two parameters -- the name of the inbox, and the file to be moved
+to.
+
+@item nnmail-delete-incoming
+@vindex nnmail-delete-incoming
+@cindex incoming mail files
+@cindex deleting incoming files
+If non-@code{nil}, the mail backends will delete the temporary incoming
+file after splitting mail into the proper groups. This is @code{t} by
+default.
+
+@c This is @code{nil} by
+@c default for reasons of security.
+
+@c Since Red Gnus is an alpha release, it is to be expected to lose mail.
+(No Gnus release since (ding) Gnus 0.10 (or something like that) have
+lost mail, I think, but that's not the point. (Except certain versions
+of Red Gnus.)) By not deleting the Incoming* files, one can be sure not
+to lose mail -- if Gnus totally whacks out, one can always recover what
+was lost.
+
+You may delete the @file{Incoming*} files at will.
+
+@item nnmail-use-long-file-names
+@vindex nnmail-use-long-file-names
+If non-@code{nil}, the mail backends will use long file and directory
+names. Groups like @samp{mail.misc} will end up in directories
+(assuming use of @code{nnml} backend) or files (assuming use of
+@code{nnfolder} backend) like @file{mail.misc}. If it is @code{nil},
+the same group will end up in @file{mail/misc}.
+
+@item nnmail-delete-file-function
+@vindex nnmail-delete-file-function
+@findex delete-file
+Function called to delete files. It is @code{delete-file} by default.
+
+@item nnmail-cache-accepted-message-ids
+@vindex nnmail-cache-accepted-message-ids
+If non-@code{nil}, put the @code{Message-ID}s of articles imported into
+the backend (via @code{Gcc}, for instance) into the mail duplication
+discovery cache. The default is @code{nil}.
+
+@end table
+
+
+@node Fancy Mail Splitting
+@subsection Fancy Mail Splitting
+@cindex mail splitting
+@cindex fancy mail splitting
+
+@vindex nnmail-split-fancy
+@findex nnmail-split-fancy
+If the rather simple, standard method for specifying how to split mail
+doesn't allow you to do what you want, you can set
+@code{nnmail-split-methods} to @code{nnmail-split-fancy}. Then you can
+play with the @code{nnmail-split-fancy} variable.
+
+Let's look at an example value of this variable first:
+
+@lisp
+;; Messages from the mailer daemon are not crossposted to any of
+;; the ordinary groups. Warnings are put in a separate group
+;; from real errors.
+(| ("from" mail (| ("subject" "warn.*" "mail.warning")
+ "mail.misc"))
+ ;; Non-error messages are crossposted to all relevant
+ ;; groups, but we don't crosspost between the group for the
+ ;; (ding) list and the group for other (ding) related mail.
+ (& (| (any "ding@@ifi\\.uio\\.no" "ding.list")
+ ("subject" "ding" "ding.misc"))
+ ;; Other mailing lists...
+ (any "procmail@@informatik\\.rwth-aachen\\.de" "procmail.list")
+ (any "SmartList@@informatik\\.rwth-aachen\\.de" "SmartList.list")
+ ;; People...
+ (any "larsi@@ifi\\.uio\\.no" "people.Lars_Magne_Ingebrigtsen"))
+ ;; Unmatched mail goes to the catch all group.
+ "misc.misc")
+@end lisp
+
+This variable has the format of a @dfn{split}. A split is a (possibly)
+recursive structure where each split may contain other splits. Here are
+the five possible split syntaxes:
+
+@enumerate
+
+@item
+@samp{group}: If the split is a string, that will be taken as a group name.
+
+@item
+@var{(FIELD VALUE SPLIT)}: If the split is a list, the first element of
+which is a string, then store the message as specified by SPLIT, if
+header FIELD (a regexp) contains VALUE (also a regexp).
+
+@item
+@var{(| SPLIT...)}: If the split is a list, and the first element is
+@code{|} (vertical bar), then process each SPLIT until one of them
+matches. A SPLIT is said to match if it will cause the mail message to
+be stored in one or more groups.
+
+@item
+@var{(& SPLIT...)}: If the split is a list, and the first element is
+@code{&}, then process all SPLITs in the list.
+
+@item
+@code{junk}: If the split is the symbol @code{junk}, then don't save
+this message anywhere.
+
+@item
+@var{(: function arg1 arg2 ...)}: If the split is a list, and the first
+element is @code{:}, then the second element will be called as a
+function with @var{args} given as arguments. The function should return
+a SPLIT.
+
+@end enumerate
+
+In these splits, @var{FIELD} must match a complete field name.
+@var{VALUE} must match a complete word according to the fundamental mode
+syntax table. You can use @code{.*} in the regexps to match partial
+field names or words. In other words, all @var{VALUE}'s are wrapped in
+@samp{\<} and @samp{\>} pairs.
+
+@vindex nnmail-split-abbrev-alist
+@var{FIELD} and @var{VALUE} can also be lisp symbols, in that case they
+are expanded as specified by the variable
+@code{nnmail-split-abbrev-alist}. This is an alist of cons cells, where
+the @code{car} of a cell contains the key, and the @code{cdr} contains the associated
+value.
+
+@vindex nnmail-split-fancy-syntax-table
+@code{nnmail-split-fancy-syntax-table} is the syntax table in effect
+when all this splitting is performed.
+
+If you want to have Gnus create groups dynamically based on some
+information in the headers (i.e., do @code{replace-match}-like
+substitions in the group names), you can say things like:
+
+@example
+(any "debian-\(\\w*\\)@@lists.debian.org" "mail.debian.\\1")
+@end example
+
+@node Mail and Procmail
+@subsection Mail and Procmail
+@cindex procmail
+
+@cindex slocal
+@cindex elm
+Many people use @code{procmail} (or some other mail filter program or
+external delivery agent---@code{slocal}, @code{elm}, etc) to split
+incoming mail into groups. If you do that, you should set
+@code{nnmail-spool-file} to @code{procmail} to ensure that the mail
+backends never ever try to fetch mail by themselves.
+
+This also means that you probably don't want to set
+@code{nnmail-split-methods} either, which has some, perhaps, unexpected
+side effects.
+
+When a mail backend is queried for what groups it carries, it replies
+with the contents of that variable, along with any groups it has figured
+out that it carries by other means. None of the backends, except
+@code{nnmh}, actually go out to the disk and check what groups actually
+exist. (It's not trivial to distinguish between what the user thinks is
+a basis for a newsgroup and what is just a plain old file or directory.)
+
+This means that you have to tell Gnus (and the backends) by hand what
+groups exist.
+
+Let's take the @code{nnmh} backend as an example:
+
+The folders are located in @code{nnmh-directory}, say, @file{~/Mail/}.
+There are three folders, @file{foo}, @file{bar} and @file{mail.baz}.
+
+Go to the group buffer and type @kbd{G m}. When prompted, answer
+@samp{foo} for the name and @samp{nnmh} for the method. Repeat
+twice for the two other groups, @samp{bar} and @samp{mail.baz}. Be sure
+to include all your mail groups.
+
+That's it. You are now set to read your mail. An active file for this
+method will be created automatically.
+
+@vindex nnmail-procmail-suffix
+@vindex nnmail-procmail-directory
+If you use @code{nnfolder} or any other backend that store more than a
+single article in each file, you should never have procmail add mails to
+the file that Gnus sees. Instead, procmail should put all incoming mail
+in @code{nnmail-procmail-directory}. To arrive at the file name to put
+the incoming mail in, append @code{nnmail-procmail-suffix} to the group
+name. The mail backends will read the mail from these files.
+
+@vindex nnmail-resplit-incoming
+When Gnus reads a file called @file{mail.misc.spool}, this mail will be
+put in the @code{mail.misc}, as one would expect. However, if you want
+Gnus to split the mail the normal way, you could set
+@code{nnmail-resplit-incoming} to @code{t}.
+
+@vindex nnmail-keep-last-article
+If you use @code{procmail} to split things directly into an @code{nnmh}
+directory (which you shouldn't do), you should set
+@code{nnmail-keep-last-article} to non-@code{nil} to prevent Gnus from
+ever expiring the final article (i.e., the article with the highest
+article number) in a mail newsgroup. This is quite, quite important.
+
+Here's an example setup: The incoming spools are located in
+@file{~/incoming/} and have @samp{""} as suffixes (i.e., the incoming
+spool files have the same names as the equivalent groups). The
+@code{nnfolder} backend is to be used as the mail interface, and the
+@code{nnfolder} directory is @file{~/fMail/}.
+
+@lisp
+(setq nnfolder-directory "~/fMail/")
+(setq nnmail-spool-file 'procmail)
+(setq nnmail-procmail-directory "~/incoming/")
+(setq gnus-secondary-select-methods '((nnfolder "")))
+(setq nnmail-procmail-suffix "")
+@end lisp
+
+
+@node Incorporating Old Mail
+@subsection Incorporating Old Mail
+
+Most people have lots of old mail stored in various file formats. If
+you have set up Gnus to read mail using one of the spiffy Gnus mail
+backends, you'll probably wish to have that old mail incorporated into
+your mail groups.
+
+Doing so can be quite easy.
+
+To take an example: You're reading mail using @code{nnml}
+(@pxref{Mail Spool}), and have set @code{nnmail-split-methods} to a
+satisfactory value (@pxref{Splitting Mail}). You have an old Unix mbox
+file filled with important, but old, mail. You want to move it into
+your @code{nnml} groups.
+
+Here's how:
+
+@enumerate
+@item
+Go to the group buffer.
+
+@item
+Type `G f' and give the path to the mbox file when prompted to create an
+@code{nndoc} group from the mbox file (@pxref{Foreign Groups}).
+
+@item
+Type `SPACE' to enter the newly created group.
+
+@item
+Type `M P b' to process-mark all articles in this group's buffer
+(@pxref{Setting Process Marks}).
+
+@item
+Type `B r' to respool all the process-marked articles, and answer
+@samp{nnml} when prompted (@pxref{Mail Group Commands}).
+@end enumerate
+
+All the mail messages in the mbox file will now also be spread out over
+all your @code{nnml} groups. Try entering them and check whether things
+have gone without a glitch. If things look ok, you may consider
+deleting the mbox file, but I wouldn't do that unless I was absolutely
+sure that all the mail has ended up where it should be.
+
+Respooling is also a handy thing to do if you're switching from one mail
+backend to another. Just respool all the mail in the old mail groups
+using the new mail backend.
+
+
+@node Expiring Mail
+@subsection Expiring Mail
+@cindex article expiry
+
+Traditional mail readers have a tendency to remove mail articles when
+you mark them as read, in some way. Gnus takes a fundamentally
+different approach to mail reading.
+
+Gnus basically considers mail just to be news that has been received in
+a rather peculiar manner. It does not think that it has the power to
+actually change the mail, or delete any mail messages. If you enter a
+mail group, and mark articles as ``read'', or kill them in some other
+fashion, the mail articles will still exist on the system. I repeat:
+Gnus will not delete your old, read mail. Unless you ask it to, of
+course.
+
+To make Gnus get rid of your unwanted mail, you have to mark the
+articles as @dfn{expirable}. This does not mean that the articles will
+disappear right away, however. In general, a mail article will be
+deleted from your system if, 1) it is marked as expirable, AND 2) it is
+more than one week old. If you do not mark an article as expirable, it
+will remain on your system until hell freezes over. This bears
+repeating one more time, with some spurious capitalizations: IF you do
+NOT mark articles as EXPIRABLE, Gnus will NEVER delete those ARTICLES.
+
+@vindex gnus-auto-expirable-newsgroups
+You do not have to mark articles as expirable by hand. Groups that
+match the regular expression @code{gnus-auto-expirable-newsgroups} will
+have all articles that you read marked as expirable automatically. All
+articles marked as expirable have an @samp{E} in the first
+column in the summary buffer.
+
+By default, if you have auto expiry switched on, Gnus will mark all the
+articles you read as expirable, no matter if they were read or unread
+before. To avoid having articles marked as read marked as expirable
+automatically, you can put something like the following in your
+@file{.gnus} file:
+
+@vindex gnus-mark-article-hook
+@lisp
+(remove-hook 'gnus-mark-article-hook
+ 'gnus-summary-mark-read-and-unread-as-read)
+(add-hook 'gnus-mark-article-hook 'gnus-summary-mark-unread-as-read)
+@end lisp
+
+Note that making a group auto-expirable doesn't mean that all read
+articles are expired---only the articles marked as expirable
+will be expired. Also note that using the @kbd{d} command won't make
+groups expirable---only semi-automatic marking of articles as read will
+mark the articles as expirable in auto-expirable groups.
+
+Let's say you subscribe to a couple of mailing lists, and you want the
+articles you have read to disappear after a while:
+
+@lisp
+(setq gnus-auto-expirable-newsgroups
+ "mail.nonsense-list\\|mail.nice-list")
+@end lisp
+
+Another way to have auto-expiry happen is to have the element
+@code{auto-expire} in the group parameters of the group.
+
+If you use adaptive scoring (@pxref{Adaptive Scoring}) and
+auto-expiring, you'll have problems. Auto-expiring and adaptive scoring
+don't really mix very well.
+
+@vindex nnmail-expiry-wait
+The @code{nnmail-expiry-wait} variable supplies the default time an
+expirable article has to live. Gnus starts counting days from when the
+message @emph{arrived}, not from when it was sent. The default is seven
+days.
+
+Gnus also supplies a function that lets you fine-tune how long articles
+are to live, based on what group they are in. Let's say you want to
+have one month expiry period in the @samp{mail.private} group, a one day
+expiry period in the @samp{mail.junk} group, and a six day expiry period
+everywhere else:
+
+@vindex nnmail-expiry-wait-function
+@lisp
+(setq nnmail-expiry-wait-function
+ (lambda (group)
+ (cond ((string= group "mail.private")
+ 31)
+ ((string= group "mail.junk")
+ 1)
+ ((string= group "important")
+ 'never)
+ (t
+ 6))))
+@end lisp
+
+The group names this function is fed are ``unadorned'' group
+names---no @samp{nnml:} prefixes and the like.
+
+The @code{nnmail-expiry-wait} variable and
+@code{nnmail-expiry-wait-function} function can either be a number (not
+necessarily an integer) or one of the symbols @code{immediate} or
+@code{never}.
+
+You can also use the @code{expiry-wait} group parameter to selectively
+change the expiry period (@pxref{Group Parameters}).
+
+@vindex nnmail-keep-last-article
+If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never
+expire the final article in a mail newsgroup. This is to make life
+easier for procmail users.
+
+@vindex gnus-total-expirable-newsgroups
+By the way: That line up there, about Gnus never expiring non-expirable
+articles, is a lie. If you put @code{total-expire} in the group
+parameters, articles will not be marked as expirable, but all read
+articles will be put through the expiry process. Use with extreme
+caution. Even more dangerous is the
+@code{gnus-total-expirable-newsgroups} variable. All groups that match
+this regexp will have all read articles put through the expiry process,
+which means that @emph{all} old mail articles in the groups in question
+will be deleted after a while. Use with extreme caution, and don't come
+crying to me when you discover that the regexp you used matched the
+wrong group and all your important mail has disappeared. Be a
+@emph{man}! Or a @emph{woman}! Whatever you feel more comfortable
+with! So there!
+
+Most people make most of their mail groups total-expirable, though.
+
+
+@node Washing Mail
+@subsection Washing Mail
+@cindex mail washing
+@cindex list server brain damage
+@cindex incoming mail treatment
+
+Mailers and list servers are notorious for doing all sorts of really,
+really stupid things with mail. ``Hey, RFC822 doesn't explicitly
+prohibit us from adding the string @code{wE aRe ElItE!!!!!1!!} to the
+end of all lines passing through our server, so let's do that!!!!1!''
+Yes, but RFC822 wasn't designed to be read by morons. Things that were
+considered to be self-evident were not discussed. So. Here we are.
+
+Case in point: The German version of Microsoft Exchange adds @samp{AW:
+} to the subjects of replies instead of @samp{Re: }. I could pretend to
+be shocked and dismayed by this, but I haven't got the energy. It is to
+laugh.
+
+Gnus provides a plethora of functions for washing articles while
+displaying them, but it might be nicer to do the filtering before
+storing the mail to disc. For that purpose, we have three hooks and
+various functions that can be put in these hooks.
+
+@table @code
+@item nnmail-prepare-incoming-hook
+@vindex nnmail-prepare-incoming-hook
+This hook is called before doing anything with the mail and is meant for
+grand, sweeping gestures. Functions to be used include:
+
+@table @code
+@item nnheader-ms-strip-cr
+@findex nnheader-ms-strip-cr
+Remove trailing carriage returns from each line. This is default on
+Emacs running on MS machines.
+
+@end table
+
+@item nnmail-prepare-incoming-header-hook
+@vindex nnmail-prepare-incoming-header-hook
+This hook is called narrowed to each header. It can be used when
+cleaning up the headers. Functions that can be used include:
+
+@table @code
+@item nnmail-remove-leading-whitespace
+@findex nnmail-remove-leading-whitespace
+Clear leading white space that ``helpful'' listservs have added to the
+headers to make them look nice. Aaah.
+
+@item nnmail-remove-list-identifiers
+@findex nnmail-remove-list-identifiers
+Some list servers add an identifier---for example, @samp{(idm)}---to the
+beginning of all @code{Subject} headers. I'm sure that's nice for
+people who use stone age mail readers. This function will remove
+strings that match the @code{nnmail-list-identifiers} regexp, which can
+also be a list of regexp.
+
+For instance, if you want to remove the @samp{(idm)} and the
+@samp{nagnagnag} identifiers:
+
+@lisp
+(setq nnmail-list-identifiers
+ '("(idm)" "nagnagnag"))
+@end lisp
+
+@item nnmail-remove-tabs
+@findex nnmail-remove-tabs
+Translate all @samp{TAB} characters into @samp{SPACE} characters.
+
+@end table
+
+@item nnmail-prepare-incoming-message-hook
+@vindex nnmail-prepare-incoming-message-hook
+This hook is called narrowed to each message. Functions to be used
+include:
+
+@table @code
+@item article-de-quoted-unreadable
+@findex article-de-quoted-unreadable
+Decode Quoted Readable encoding.
+
+@end table
+@end table
+
+
+@node Duplicates
+@subsection Duplicates
+
+@vindex nnmail-treat-duplicates
+@vindex nnmail-message-id-cache-length
+@vindex nnmail-message-id-cache-file
+@cindex duplicate mails
+If you are a member of a couple of mailing lists, you will sometimes
+receive two copies of the same mail. This can be quite annoying, so
+@code{nnmail} checks for and treats any duplicates it might find. To do
+this, it keeps a cache of old @code{Message-ID}s---
+@code{nnmail-message-id-cache-file}, which is @file{~/.nnmail-cache} by
+default. The approximate maximum number of @code{Message-ID}s stored
+there is controlled by the @code{nnmail-message-id-cache-length}
+variable, which is 1000 by default. (So 1000 @code{Message-ID}s will be
+stored.) If all this sounds scary to you, you can set
+@code{nnmail-treat-duplicates} to @code{warn} (which is what it is by
+default), and @code{nnmail} won't delete duplicate mails. Instead it
+will insert a warning into the head of the mail saying that it thinks
+that this is a duplicate of a different message.
+
+This variable can also be a function. If that's the case, the function
+will be called from a buffer narrowed to the message in question with
+the @code{Message-ID} as a parameter. The function must return either
+@code{nil}, @code{warn}, or @code{delete}.
+
+You can turn this feature off completely by setting the variable to
+@code{nil}.
+
+If you want all the duplicate mails to be put into a special
+@dfn{duplicates} group, you could do that using the normal mail split
+methods:
+
+@lisp
+(setq nnmail-split-fancy
+ '(| ;; Messages duplicates go to a separate group.
+ ("gnus-warning" "duplication of message" "duplicate")
+ ;; Message from daemons, postmaster, and the like to another.
+ (any mail "mail.misc")
+ ;; Other rules.
+ [ ... ] ))
+@end lisp
+
+Or something like:
+@lisp
+(setq nnmail-split-methods
+ '(("duplicates" "^Gnus-Warning:")
+ ;; Other rules.
+ [...]))
+@end lisp
+
+Here's a neat feature: If you know that the recipient reads her mail
+with Gnus, and that she has @code{nnmail-treat-duplicates} set to
+@code{delete}, you can send her as many insults as you like, just by
+using a @code{Message-ID} of a mail that you know that she's already
+received. Think of all the fun! She'll never see any of it! Whee!
+
+
+@node Not Reading Mail
+@subsection Not Reading Mail
+
+If you start using any of the mail backends, they have the annoying
+habit of assuming that you want to read mail with them. This might not
+be unreasonable, but it might not be what you want.
+
+If you set @code{nnmail-spool-file} to @code{nil}, none of the backends
+will ever attempt to read incoming mail, which should help.
+
+@vindex nnbabyl-get-new-mail
+@vindex nnmbox-get-new-mail
+@vindex nnml-get-new-mail
+@vindex nnmh-get-new-mail
+@vindex nnfolder-get-new-mail
+This might be too much, if, for instance, you are reading mail quite
+happily with @code{nnml} and just want to peek at some old @sc{rmail}
+file you have stashed away with @code{nnbabyl}. All backends have
+variables called backend-@code{get-new-mail}. If you want to disable
+the @code{nnbabyl} mail reading, you edit the virtual server for the
+group to have a setting where @code{nnbabyl-get-new-mail} to @code{nil}.
+
+All the mail backends will call @code{nn}*@code{-prepare-save-mail-hook}
+narrowed to the article to be saved before saving it when reading
+incoming mail.
+
+
+@node Choosing a Mail Backend
+@subsection Choosing a Mail Backend
+
+Gnus will read the mail spool when you activate a mail group. The mail
+file is first copied to your home directory. What happens after that
+depends on what format you want to store your mail in.
+
+@menu
+* Unix Mail Box:: Using the (quite) standard Un*x mbox.
+* Rmail Babyl:: Emacs programs use the rmail babyl format.
+* Mail Spool:: Store your mail in a private spool?
+* MH Spool:: An mhspool-like backend.
+* Mail Folders:: Having one file for each group.
+@end menu
+
+
+@node Unix Mail Box
+@subsubsection Unix Mail Box
+@cindex nnmbox
+@cindex unix mail box
+
+@vindex nnmbox-active-file
+@vindex nnmbox-mbox-file
+The @dfn{nnmbox} backend will use the standard Un*x mbox file to store
+mail. @code{nnmbox} will add extra headers to each mail article to say
+which group it belongs in.
+
+Virtual server settings:
+
+@table @code
+@item nnmbox-mbox-file
+@vindex nnmbox-mbox-file
+The name of the mail box in the user's home directory.
+
+@item nnmbox-active-file
+@vindex nnmbox-active-file
+The name of the active file for the mail box.
+
+@item nnmbox-get-new-mail
+@vindex nnmbox-get-new-mail
+If non-@code{nil}, @code{nnmbox} will read incoming mail and split it
+into groups.
+@end table
+
+
+@node Rmail Babyl
+@subsubsection Rmail Babyl
+@cindex nnbabyl
+@cindex rmail mbox
+
+@vindex nnbabyl-active-file
+@vindex nnbabyl-mbox-file
+The @dfn{nnbabyl} backend will use a babyl mail box (aka. @dfn{rmail
+mbox}) to store mail. @code{nnbabyl} will add extra headers to each mail
+article to say which group it belongs in.
+
+Virtual server settings:
+
+@table @code
+@item nnbabyl-mbox-file
+@vindex nnbabyl-mbox-file
+The name of the rmail mbox file.
+
+@item nnbabyl-active-file
+@vindex nnbabyl-active-file
+The name of the active file for the rmail box.
+
+@item nnbabyl-get-new-mail
+@vindex nnbabyl-get-new-mail
+If non-@code{nil}, @code{nnbabyl} will read incoming mail.
+@end table
+
+
+@node Mail Spool
+@subsubsection Mail Spool
+@cindex nnml
+@cindex mail @sc{nov} spool
+
+The @dfn{nnml} spool mail format isn't compatible with any other known
+format. It should be used with some caution.
+
+@vindex nnml-directory
+If you use this backend, Gnus will split all incoming mail into files,
+one file for each mail, and put the articles into the corresponding
+directories under the directory specified by the @code{nnml-directory}
+variable. The default value is @file{~/Mail/}.
+
+You do not have to create any directories beforehand; Gnus will take
+care of all that.
+
+If you have a strict limit as to how many files you are allowed to store
+in your account, you should not use this backend. As each mail gets its
+own file, you might very well occupy thousands of inodes within a few
+weeks. If this is no problem for you, and it isn't a problem for you
+having your friendly systems administrator walking around, madly,
+shouting ``Who is eating all my inodes?! Who? Who!?!'', then you should
+know that this is probably the fastest format to use. You do not have
+to trudge through a big mbox file just to read your new mail.
+
+@code{nnml} is probably the slowest backend when it comes to article
+splitting. It has to create lots of files, and it also generates
+@sc{nov} databases for the incoming mails. This makes it the fastest
+backend when it comes to reading mail.
+
+Virtual server settings:
+
+@table @code
+@item nnml-directory
+@vindex nnml-directory
+All @code{nnml} directories will be placed under this directory.
+
+@item nnml-active-file
+@vindex nnml-active-file
+The active file for the @code{nnml} server.
+
+@item nnml-newsgroups-file
+@vindex nnml-newsgroups-file
+The @code{nnml} group descriptions file. @xref{Newsgroups File
+Format}.
+
+@item nnml-get-new-mail
+@vindex nnml-get-new-mail
+If non-@code{nil}, @code{nnml} will read incoming mail.
+
+@item nnml-nov-is-evil
+@vindex nnml-nov-is-evil
+If non-@code{nil}, this backend will ignore any @sc{nov} files.
+
+@item nnml-nov-file-name
+@vindex nnml-nov-file-name
+The name of the @sc{nov} files. The default is @file{.overview}.
+
+@item nnml-prepare-save-mail-hook
+@vindex nnml-prepare-save-mail-hook
+Hook run narrowed to an article before saving.
+
+@end table
+
+@findex nnml-generate-nov-databases
+If your @code{nnml} groups and @sc{nov} files get totally out of whack,
+you can do a complete update by typing @kbd{M-x
+nnml-generate-nov-databases}. This command will trawl through the
+entire @code{nnml} hierarchy, looking at each and every article, so it
+might take a while to complete. A better interface to this
+functionality can be found in the server buffer (@pxref{Server
+Commands}).
+
+
+@node MH Spool
+@subsubsection MH Spool
+@cindex nnmh
+@cindex mh-e mail spool
+
+@code{nnmh} is just like @code{nnml}, except that is doesn't generate
+@sc{nov} databases and it doesn't keep an active file. This makes
+@code{nnmh} a @emph{much} slower backend than @code{nnml}, but it also
+makes it easier to write procmail scripts for.
+
+Virtual server settings:
+
+@table @code
+@item nnmh-directory
+@vindex nnmh-directory
+All @code{nnmh} directories will be located under this directory.
+
+@item nnmh-get-new-mail
+@vindex nnmh-get-new-mail
+If non-@code{nil}, @code{nnmh} will read incoming mail.
+
+@item nnmh-be-safe
+@vindex nnmh-be-safe
+If non-@code{nil}, @code{nnmh} will go to ridiculous lengths to make
+sure that the articles in the folder are actually what Gnus thinks they
+are. It will check date stamps and stat everything in sight, so
+setting this to @code{t} will mean a serious slow-down. If you never
+use anything but Gnus to read the @code{nnmh} articles, you do not have
+to set this variable to @code{t}.
+@end table
+
+
+@node Mail Folders
+@subsubsection Mail Folders
+@cindex nnfolder
+@cindex mbox folders
+@cindex mail folders
+
+@code{nnfolder} is a backend for storing each mail group in a 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.
+
+Virtual server settings:
+
+@table @code
+@item nnfolder-directory
+@vindex nnfolder-directory
+All the @code{nnfolder} mail boxes will be stored under this directory.
+
+@item nnfolder-active-file
+@vindex nnfolder-active-file
+The name of the active file.
+
+@item nnfolder-newsgroups-file
+@vindex nnfolder-newsgroups-file
+The name of the group descriptions file. @xref{Newsgroups File Format}.
+
+@item nnfolder-get-new-mail
+@vindex nnfolder-get-new-mail
+If non-@code{nil}, @code{nnfolder} will read incoming mail.
+@end table
+
+@findex nnfolder-generate-active-file
+@kindex M-x nnfolder-generate-active-file
+If you have lots of @code{nnfolder}-like files you'd like to read with
+@code{nnfolder}, you can use the @kbd{M-x nnfolder-generate-active-file}
+command to make @code{nnfolder} aware of all likely files in
+@code{nnfolder-directory}.
+
+
+@node Other Sources
+@section Other Sources
+
+Gnus can do more than just read news or mail. The methods described
+below allow Gnus to view directories and files as if they were
+newsgroups.
+
+@menu
+* Directory Groups:: You can read a directory as if it was a newsgroup.
+* Anything Groups:: Dired? Who needs dired?
+* Document Groups:: Single files can be the basis of a group.
+* SOUP:: Reading @sc{SOUP} packets ``offline''.
+* Web Searches:: Creating groups from articles that match a string.
+* Mail-To-News Gateways:: Posting articles via mail-to-news gateways.
+@end menu
+
+
+@node Directory Groups
+@subsection Directory Groups
+@cindex nndir
+@cindex directory groups
+
+If you have a directory that has lots of articles in separate files in
+it, you might treat it as a newsgroup. The files have to have numerical
+names, of course.
+
+This might be an opportune moment to mention @code{ange-ftp} (and its
+successor @code{efs}), that most wonderful of all wonderful Emacs
+packages. When I wrote @code{nndir}, I didn't think much about it---a
+backend to read directories. Big deal.
+
+@code{ange-ftp} changes that picture dramatically. For instance, if you
+enter the @code{ange-ftp} file name
+@file{/ftp.hpc.uh.edu:/pub/emacs/ding-list/} as the directory name,
+@code{ange-ftp} or @code{efs} will actually allow you to read this
+directory over at @samp{sina} as a newsgroup. Distributed news ahoy!
+
+@code{nndir} will use @sc{nov} files if they are present.
+
+@code{nndir} is a ``read-only'' backend---you can't delete or expire
+articles with this method. You can use @code{nnmh} or @code{nnml} for
+whatever you use @code{nndir} for, so you could switch to any of those
+methods if you feel the need to have a non-read-only @code{nndir}.
+
+
+@node Anything Groups
+@subsection Anything Groups
+@cindex nneething
+
+From the @code{nndir} backend (which reads a single spool-like
+directory), it's just a hop and a skip to @code{nneething}, which
+pretends that any arbitrary directory is a newsgroup. Strange, but
+true.
+
+When @code{nneething} is presented with a directory, it will scan this
+directory and assign article numbers to each file. When you enter such
+a group, @code{nneething} must create ``headers'' that Gnus can use.
+After all, Gnus is a newsreader, in case you're
+forgetting. @code{nneething} does this in a two-step process. First, it
+snoops each file in question. If the file looks like an article (i.e.,
+the first few lines look like headers), it will use this as the head.
+If this is just some arbitrary file without a head (e.g. a C source
+file), @code{nneething} will cobble up a header out of thin air. It
+will use file ownership, name and date and do whatever it can with these
+elements.
+
+All this should happen automatically for you, and you will be presented
+with something that looks very much like a newsgroup. Totally like a
+newsgroup, to be precise. If you select an article, it will be displayed
+in the article buffer, just as usual.
+
+If you select a line that represents a directory, Gnus will pop you into
+a new summary buffer for this @code{nneething} group. And so on. You can
+traverse the entire disk this way, if you feel like, but remember that
+Gnus is not dired, really, and does not intend to be, either.
+
+There are two overall modes to this action---ephemeral or solid. When
+doing the ephemeral thing (i.e., @kbd{G D} from the group buffer), Gnus
+will not store information on what files you have read, and what files
+are new, and so on. If you create a solid @code{nneething} group the
+normal way with @kbd{G m}, Gnus will store a mapping table between
+article numbers and file names, and you can treat this group like any
+other groups. When you activate a solid @code{nneething} group, you will
+be told how many unread articles it contains, etc., etc.
+
+Some variables:
+
+@table @code
+@item nneething-map-file-directory
+@vindex nneething-map-file-directory
+All the mapping files for solid @code{nneething} groups will be stored
+in this directory, which defaults to @file{~/.nneething/}.
+
+@item nneething-exclude-files
+@vindex nneething-exclude-files
+All files that match this regexp will be ignored. Nice to use to exclude
+auto-save files and the like, which is what it does by default.
+
+@item nneething-map-file
+@vindex nneething-map-file
+Name of the map files.
+@end table
+
+
+@node Document Groups
+@subsection Document Groups
+@cindex nndoc
+@cindex documentation group
+@cindex help group
+
+@code{nndoc} is a cute little thing that will let you read a single file
+as a newsgroup. Several files types are supported:
+
+@table @code
+@cindex babyl
+@cindex rmail mbox
+
+@item babyl
+The babyl (rmail) mail box.
+@cindex mbox
+@cindex Unix mbox
+
+@item mbox
+The standard Unix mbox file.
+
+@cindex MMDF mail box
+@item mmdf
+The MMDF mail box format.
+
+@item news
+Several news articles appended into a file.
+
+@item rnews
+@cindex rnews batch files
+The rnews batch transport format.
+@cindex forwarded messages
+
+@item forward
+Forwarded articles.
+
+@item mime-digest
+@cindex digest
+@cindex MIME digest
+@cindex 1153 digest
+@cindex RFC 1153 digest
+@cindex RFC 341 digest
+MIME (RFC 1341) digest format.
+
+@item standard-digest
+The standard (RFC 1153) digest format.
+
+@item slack-digest
+Non-standard digest format---matches most things, but does it badly.
+@end table
+
+You can also use the special ``file type'' @code{guess}, which means
+that @code{nndoc} will try to guess what file type it is looking at.
+@code{digest} means that @code{nndoc} should guess what digest type the
+file is.
+
+@code{nndoc} will not try to change the file or insert any extra headers into
+it---it will simply, like, let you use the file as the basis for a
+group. And that's it.
+
+If you have some old archived articles that you want to insert into your
+new & spiffy Gnus mail backend, @code{nndoc} can probably help you with
+that. Say you have an old @file{RMAIL} file with mail that you now want
+to split into your new @code{nnml} groups. You look at that file using
+@code{nndoc} (using the @kbd{G f} command in the group buffer
+(@pxref{Foreign Groups})), set the process mark on all the articles in
+the buffer (@kbd{M P b}, for instance), and then re-spool (@kbd{B r})
+using @code{nnml}. If all goes well, all the mail in the @file{RMAIL}
+file is now also stored in lots of @code{nnml} directories, and you can
+delete that pesky @file{RMAIL} file. If you have the guts!
+
+Virtual server variables:
+
+@table @code
+@item nndoc-article-type
+@vindex nndoc-article-type
+This should be one of @code{mbox}, @code{babyl}, @code{digest},
+@code{news}, @code{rnews}, @code{mmdf}, @code{forward}, @code{rfc934},
+@code{rfc822-forward}, @code{mime-digest}, @code{standard-digest},
+@code{slack-digest}, @code{clari-briefs} or @code{guess}.
+
+@item nndoc-post-type
+@vindex nndoc-post-type
+This variable says whether Gnus is to consider the group a news group or
+a mail group. There are two valid values: @code{mail} (the default)
+and @code{news}.
+@end table
+
+@menu
+* Document Server Internals:: How to add your own document types.
+@end menu
+
+
+@node Document Server Internals
+@subsubsection Document Server Internals
+
+Adding new document types to be recognized by @code{nndoc} isn't
+difficult. You just have to whip up a definition of what the document
+looks like, write a predicate function to recognize that document type,
+and then hook into @code{nndoc}.
+
+First, here's an example document type definition:
+
+@example
+(mmdf
+ (article-begin . "^\^A\^A\^A\^A\n")
+ (body-end . "^\^A\^A\^A\^A\n"))
+@end example
+
+The definition is simply a unique @dfn{name} followed by a series of
+regexp pseudo-variable settings. Below are the possible
+variables---don't be daunted by the number of variables; most document
+types can be defined with very few settings:
+
+@table @code
+@item first-article
+If present, @code{nndoc} will skip past all text until it finds
+something that match this regexp. All text before this will be
+totally ignored.
+
+@item article-begin
+This setting has to be present in all document type definitions. It
+says what the beginning of each article looks like.
+
+@item head-begin-function
+If present, this should be a function that moves point to the head of
+the article.
+
+@item nndoc-head-begin
+If present, this should be a regexp that matches the head of the
+article.
+
+@item nndoc-head-end
+This should match the end of the head of the article. It defaults to
+@samp{^$}---the empty line.
+
+@item body-begin-function
+If present, this function should move point to the beginning of the body
+of the article.
+
+@item body-begin
+This should match the beginning of the body of the article. It defaults
+to @samp{^\n}.
+
+@item body-end-function
+If present, this function should move point to the end of the body of
+the article.
+
+@item body-end
+If present, this should match the end of the body of the article.
+
+@item file-end
+If present, this should match the end of the file. All text after this
+regexp will be totally ignored.
+
+@end table
+
+So, using these variables @code{nndoc} is able to dissect a document
+file into a series of articles, each with a head and a body. However, a
+few more variables are needed since not all document types are all that
+news-like---variables needed to transform the head or the body into
+something that's palatable for Gnus:
+
+@table @code
+@item prepare-body-function
+If present, this function will be called when requesting an article. It
+will be called with point at the start of the body, and is useful if the
+document has encoded some parts of its contents.
+
+@item article-transform-function
+If present, this function is called when requesting an article. It's
+meant to be used for more wide-ranging transformation of both head and
+body of the article.
+
+@item generate-head-function
+If present, this function is called to generate a head that Gnus can
+understand. It is called with the article number as a parameter, and is
+expected to generate a nice head for the article in question. It is
+called when requesting the headers of all articles.
+
+@end table
+
+Let's look at the most complicated example I can come up with---standard
+digests:
+
+@example
+(standard-digest
+ (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+"))
+ (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+"))
+ (prepare-body-function . nndoc-unquote-dashes)
+ (body-end-function . nndoc-digest-body-end)
+ (head-end . "^ ?$")
+ (body-begin . "^ ?\n")
+ (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
+ (subtype digest guess))
+@end example
+
+We see that all text before a 70-width line of dashes is ignored; all
+text after a line that starts with that @samp{^End of} is also ignored;
+each article begins with a 30-width line of dashes; the line separating
+the head from the body may contain a single space; and that the body is
+run through @code{nndoc-unquote-dashes} before being delivered.
+
+To hook your own document definition into @code{nndoc}, use the
+@code{nndoc-add-type} function. It takes two parameters---the first is
+the definition itself and the second (optional) parameter says where in
+the document type definition alist to put this definition. The alist is
+traversed sequentially, and @code{nndoc-TYPE-type-p} is called for a given type @code{TYPE}. So @code{nndoc-mmdf-type-p} is called to see whether a document
+is of @code{mmdf} type, and so on. These type predicates should return
+@code{nil} if the document is not of the correct type; @code{t} if it is
+of the correct type; and a number if the document might be of the
+correct type. A high number means high probability; a low number means
+low probability with @samp{0} being the lowest valid number.
+
+
+@node SOUP
+@subsection SOUP
+@cindex SOUP
+@cindex offline
+
+In the PC world people often talk about ``offline'' newsreaders. These
+are thingies that are combined reader/news transport monstrosities.
+With built-in modem programs. Yecchh!
+
+Of course, us Unix Weenie types of human beans use things like
+@code{uucp} and, like, @code{nntpd} and set up proper news and mail
+transport things like Ghod intended. And then we just use normal
+newsreaders.
+
+However, it can sometimes be convenient to do something a that's a bit
+easier on the brain if you have a very slow modem, and you're not really
+that interested in doing things properly.
+
+A file format called @sc{soup} has been developed for transporting news
+and mail from servers to home machines and back again. It can be a bit
+fiddly.
+
+First some terminology:
+
+@table @dfn
+
+@item server
+This is the machine that is connected to the outside world and where you
+get news and/or mail from.
+
+@item home machine
+This is the machine that you want to do the actual reading and responding
+on. It is typically not connected to the rest of the world in any way.
+
+@item packet
+Something that contains messages and/or commands. There are two kinds
+of packets:
+
+@table @dfn
+@item message packets
+These are packets made at the server, and typically contain lots of
+messages for you to read. These are called @file{SoupoutX.tgz} by
+default, where @var{X} is a number.
+
+@item response packets
+These are packets made at the home machine, and typically contains
+replies that you've written. These are called @file{SoupinX.tgz} by
+default, where @var{X} is a number.
+
+@end table
+
+@end table
+
+
+@enumerate
+
+@item
+You log in on the server and create a @sc{soup} packet. You can either
+use a dedicated @sc{soup} thingie (like the @code{awk} program), or you
+can use Gnus to create the packet with its @sc{soup} commands (@kbd{O
+s} and/or @kbd{G s b}; and then @kbd{G s p}) (@pxref{SOUP Commands}).
+
+@item
+You transfer the packet home. Rail, boat, car or modem will do fine.
+
+@item
+You put the packet in your home directory.
+
+@item
+You fire up Gnus on your home machine using the @code{nnsoup} backend as
+the native or secondary server.
+
+@item
+You read articles and mail and answer and followup to the things you
+want (@pxref{SOUP Replies}).
+
+@item
+You do the @kbd{G s r} command to pack these replies into a @sc{soup}
+packet.
+
+@item
+You transfer this packet to the server.
+
+@item
+You use Gnus to mail this packet out with the @kbd{G s s} command.
+
+@item
+You then repeat until you die.
+
+@end enumerate
+
+So you basically have a bipartite system---you use @code{nnsoup} for
+reading and Gnus for packing/sending these @sc{soup} packets.
+
+@menu
+* SOUP Commands:: Commands for creating and sending @sc{soup} packets
+* SOUP Groups:: A backend for reading @sc{soup} packets.
+* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news.
+@end menu
+
+
+@node SOUP Commands
+@subsubsection SOUP Commands
+
+These are commands for creating and manipulating @sc{soup} packets.
+
+@table @kbd
+@item G s b
+@kindex G s b (Group)
+@findex gnus-group-brew-soup
+Pack all unread articles in the current group
+(@code{gnus-group-brew-soup}). This command understands the
+process/prefix convention.
+
+@item G s w
+@kindex G s w (Group)
+@findex gnus-soup-save-areas
+Save all @sc{soup} data files (@code{gnus-soup-save-areas}).
+
+@item G s s
+@kindex G s s (Group)
+@findex gnus-soup-send-replies
+Send all replies from the replies packet
+(@code{gnus-soup-send-replies}).
+
+@item G s p
+@kindex G s p (Group)
+@findex gnus-soup-pack-packet
+Pack all files into a @sc{soup} packet (@code{gnus-soup-pack-packet}).
+
+@item G s r
+@kindex G s r (Group)
+@findex nnsoup-pack-replies
+Pack all replies into a replies packet (@code{nnsoup-pack-replies}).
+
+@item O s
+@kindex O s (Summary)
+@findex gnus-soup-add-article
+This summary-mode command adds the current article to a @sc{soup} packet
+(@code{gnus-soup-add-article}). It understands the process/prefix
+convention (@pxref{Process/Prefix}).
+
+@end table
+
+
+There are a few variables to customize where Gnus will put all these
+thingies:
+
+@table @code
+
+@item gnus-soup-directory
+@vindex gnus-soup-directory
+Directory where Gnus will save intermediate files while composing
+@sc{soup} packets. The default is @file{~/SoupBrew/}.
+
+@item gnus-soup-replies-directory
+@vindex gnus-soup-replies-directory
+This is what Gnus will use as a temporary directory while sending our
+reply packets. @file{~/SoupBrew/SoupReplies/} is the default.
+
+@item gnus-soup-prefix-file
+@vindex gnus-soup-prefix-file
+Name of the file where Gnus stores the last used prefix. The default is
+@samp{gnus-prefix}.
+
+@item gnus-soup-packer
+@vindex gnus-soup-packer
+A format string command for packing a @sc{soup} packet. The default is
+@samp{tar cf - %s | gzip > $HOME/Soupout%d.tgz}.
+
+@item gnus-soup-unpacker
+@vindex gnus-soup-unpacker
+Format string command for unpacking a @sc{soup} packet. The default is
+@samp{gunzip -c %s | tar xvf -}.
+
+@item gnus-soup-packet-directory
+@vindex gnus-soup-packet-directory
+Where Gnus will look for reply packets. The default is @file{~/}.
+
+@item gnus-soup-packet-regexp
+@vindex gnus-soup-packet-regexp
+Regular expression matching @sc{soup} reply packets in
+@code{gnus-soup-packet-directory}.
+
+@end table
+
+
+@node SOUP Groups
+@subsubsection @sc{soup} Groups
+@cindex nnsoup
+
+@code{nnsoup} is the backend for reading @sc{soup} packets. It will
+read incoming packets, unpack them, and put them in a directory where
+you can read them at leisure.
+
+These are the variables you can use to customize its behavior:
+
+@table @code
+
+@item nnsoup-tmp-directory
+@vindex nnsoup-tmp-directory
+When @code{nnsoup} unpacks a @sc{soup} packet, it does it in this
+directory. (@file{/tmp/} by default.)
+
+@item nnsoup-directory
+@vindex nnsoup-directory
+@code{nnsoup} then moves each message and index file to this directory.
+The default is @file{~/SOUP/}.
+
+@item nnsoup-replies-directory
+@vindex nnsoup-replies-directory
+All replies will be stored in this directory before being packed into a
+reply packet. The default is @file{~/SOUP/replies/"}.
+
+@item nnsoup-replies-format-type
+@vindex nnsoup-replies-format-type
+The @sc{soup} format of the replies packets. The default is @samp{?n}
+(rnews), and I don't think you should touch that variable. I probably
+shouldn't even have documented it. Drats! Too late!
+
+@item nnsoup-replies-index-type
+@vindex nnsoup-replies-index-type
+The index type of the replies packet. The default is @samp{?n}, which
+means ``none''. Don't fiddle with this one either!
+
+@item nnsoup-active-file
+@vindex nnsoup-active-file
+Where @code{nnsoup} stores lots of information. This is not an ``active
+file'' in the @code{nntp} sense; it's an Emacs Lisp file. If you lose
+this file or mess it up in any way, you're dead. The default is
+@file{~/SOUP/active}.
+
+@item nnsoup-packer
+@vindex nnsoup-packer
+Format string command for packing a reply @sc{soup} packet. The default
+is @samp{tar cf - %s | gzip > $HOME/Soupin%d.tgz}.
+
+@item nnsoup-unpacker
+@vindex nnsoup-unpacker
+Format string command for unpacking incoming @sc{soup} packets. The
+default is @samp{gunzip -c %s | tar xvf -}.
+
+@item nnsoup-packet-directory
+@vindex nnsoup-packet-directory
+Where @code{nnsoup} will look for incoming packets. The default is
+@file{~/}.
+
+@item nnsoup-packet-regexp
+@vindex nnsoup-packet-regexp
+Regular expression matching incoming @sc{soup} packets. The default is
+@samp{Soupout}.
+
+@item nnsoup-always-save
+@vindex nnsoup-always-save
+If non-@code{nil}, save the replies buffer after each posted message.
+
+@end table
+
+
+@node SOUP Replies
+@subsubsection SOUP Replies
+
+Just using @code{nnsoup} won't mean that your postings and mailings end
+up in @sc{soup} reply packets automagically. You have to work a bit
+more for that to happen.
+
+@findex nnsoup-set-variables
+The @code{nnsoup-set-variables} command will set the appropriate
+variables to ensure that all your followups and replies end up in the
+@sc{soup} system.
+
+In specific, this is what it does:
+
+@lisp
+(setq message-send-news-function 'nnsoup-request-post)
+(setq message-send-mail-function 'nnsoup-request-mail)
+@end lisp
+
+And that's it, really. If you only want news to go into the @sc{soup}
+system you just use the first line. If you only want mail to be
+@sc{soup}ed you use the second.
+
+
+@node Web Searches
+@subsection Web Searches
+@cindex nnweb
+@cindex DejaNews
+@cindex Alta Vista
+@cindex InReference
+@cindex Usenet searches
+@cindex searching the Usenet
+
+It's, like, too neat to search the Usenet for articles that match a
+string, but it, like, totally @emph{sucks}, like, totally, to use one of
+those, like, Web browsers, and you, like, have to, rilly, like, look at
+the commercials, so, like, with Gnus you can do @emph{rad}, rilly,
+searches without having to use a browser.
+
+The @code{nnweb} backend allows an easy interface to the mighty search
+engine. You create an @code{nnweb} group, enter a search pattern, and
+then enter the group and read the articles like you would any normal
+group. The @kbd{G w} command in the group buffer (@pxref{Foreign
+Groups}) will do this in an easy-to-use fashion.
+
+@code{nnweb} groups don't really lend themselves to being solid
+groups---they have a very fleeting idea of article numbers. In fact,
+each time you enter an @code{nnweb} group (not even changing the search
+pattern), you are likely to get the articles ordered in a different
+manner. Not even using duplicate suppression (@pxref{Duplicate
+Suppression}) will help, since @code{nnweb} doesn't even know the
+@code{Message-ID} of the articles before reading them using some search
+engines (DejaNews, for instance). The only possible way to keep track
+of which articles you've read is by scoring on the @code{Date}
+header---mark all articles posted before the last date you read the
+group as read.
+
+If the search engine changes its output substantially, @code{nnweb}
+won't be able to parse it and will fail. One could hardly fault the Web
+providers if they were to do this---their @emph{raison d'être} is to
+make money off of advertisements, not to provide services to the
+community. Since @code{nnweb} washes the ads off all the articles, one
+might think that the providers might be somewhat miffed. We'll see.
+
+You must have the @code{url} and @code{w3} package installed to be able
+to use @code{nnweb}.
+
+Virtual server variables:
+
+@table @code
+@item nnweb-type
+@vindex nnweb-type
+What search engine type is being used. The currently supported types
+are @code{dejanews}, @code{altavista} and @code{reference}.
+
+@item nnweb-search
+@vindex nnweb-search
+The search string to feed to the search engine.
+
+@item nnweb-max-hits
+@vindex nnweb-max-hits
+Advisory maximum number of hits per search to display. The default is
+100.
+
+@item nnweb-type-definition
+@vindex nnweb-type-definition
+Type-to-definition alist. This alist says what @code{nnweb} should do
+with the various search engine types. The following elements must be
+present:
+
+@table @code
+@item article
+Function to decode the article and provide something that Gnus
+understands.
+
+@item map
+Function to create an article number to message header and URL alist.
+
+@item search
+Function to send the search string to the search engine.
+
+@item address
+The address the aforementioned function should send the search string
+to.
+
+@item id
+Format string URL to fetch an article by @code{Message-ID}.
+@end table
+
+@end table
+
+
+
+@node Mail-To-News Gateways
+@subsection Mail-To-News Gateways
+@cindex mail-to-news gateways
+@cindex gateways
+
+If your local @code{nntp} server doesn't allow posting, for some reason
+or other, you can post using one of the numerous mail-to-news gateways.
+The @code{nngateway} backend provides the interface.
+
+Note that you can't read anything from this backend---it can only be
+used to post with.
+
+Server variables:
+
+@table @code
+@item nngateway-address
+@vindex nngateway-address
+This is the address of the mail-to-news gateway.
+
+@item nngateway-header-transformation
+@vindex nngateway-header-transformation
+News headers often have to be transformed in some odd way or other
+for the mail-to-news gateway to accept it. This variable says what
+transformation should be called, and defaults to
+@code{nngateway-simple-header-transformation}. The function is called
+narrowed to the headers to be transformed and with one parameter---the
+gateway address.
+
+This default function just inserts a new @code{To} header based on the
+@code{Newsgroups} header and the gateway address.
+For instance, an article with this @code{Newsgroups} header:
+
+@example
+Newsgroups: alt.religion.emacs
+@end example
+
+will get this @code{From} header inserted:
+
+@example
+To: alt-religion-emacs@@GATEWAY
+@end example
+
+@end table
+
+So, to use this, simply say something like:
+
+@lisp
+(setq gnus-post-method '(nngateway "GATEWAY.ADDRESS"))
+@end lisp
+
+
+@node Combined Groups
+@section Combined Groups
+
+Gnus allows combining a mixture of all the other group types into bigger
+groups.
+
+@menu
+* Virtual Groups:: Combining articles from many groups.
+* Kibozed Groups:: Looking through parts of the newsfeed for articles.
+@end menu
+
+
+@node Virtual Groups
+@subsection Virtual Groups
+@cindex nnvirtual
+@cindex virtual groups
+
+An @dfn{nnvirtual group} is really nothing more than a collection of
+other groups.
+
+For instance, if you are tired of reading many small groups, you can
+put them all in one big group, and then grow tired of reading one
+big, unwieldy group. The joys of computing!
+
+You specify @code{nnvirtual} as the method. The address should be a
+regexp to match component groups.
+
+All marks in the virtual group will stick to the articles in the
+component groups. So if you tick an article in a virtual group, the
+article will also be ticked in the component group from whence it came.
+(And vice versa---marks from the component groups will also be shown in
+the virtual group.)
+
+Here's an example @code{nnvirtual} method that collects all Andrea Dworkin
+newsgroups into one, big, happy newsgroup:
+
+@lisp
+(nnvirtual "^alt\\.fan\\.andrea-dworkin$\\|^rec\\.dworkin.*")
+@end lisp
+
+The component groups can be native or foreign; everything should work
+smoothly, but if your computer explodes, it was probably my fault.
+
+Collecting the same group from several servers might actually be a good
+idea if users have set the Distribution header to limit distribution.
+If you would like to read @samp{soc.motss} both from a server in Japan
+and a server in Norway, you could use the following as the group regexp:
+
+@example
+"^nntp+some.server.jp:soc.motss$\\|^nntp+some.server.no:soc.motss$"
+@end example
+
+This should work kinda smoothly---all articles from both groups should
+end up in this one, and there should be no duplicates. Threading (and
+the rest) will still work as usual, but there might be problems with the
+sequence of articles. Sorting on date might be an option here
+(@pxref{Selecting a Group}).
+
+One limitation, however---all groups included in a virtual
+group have to be alive (i.e., subscribed or unsubscribed). Killed or
+zombie groups can't be component groups for @code{nnvirtual} groups.
+
+@vindex nnvirtual-always-rescan
+If the @code{nnvirtual-always-rescan} is non-@code{nil},
+@code{nnvirtual} will always scan groups for unread articles when
+entering a virtual group. If this variable is @code{nil} (which is the
+default) and you read articles in a component group after the virtual
+group has been activated, the read articles from the component group
+will show up when you enter the virtual group. You'll also see this
+effect if you have two virtual groups that have a component group in
+common. If that's the case, you should set this variable to @code{t}.
+Or you can just tap @code{M-g} on the virtual group every time before
+you enter it---it'll have much the same effect.
+
+
+@node Kibozed Groups
+@subsection Kibozed Groups
+@cindex nnkiboze
+@cindex kibozing
+
+@dfn{Kibozing} is defined by @sc{oed} as ``grepping through (parts of)
+the news feed''. @code{nnkiboze} is a backend that will do this for
+you. Oh joy! Now you can grind any @sc{nntp} server down to a halt
+with useless requests! Oh happiness!
+
+@kindex G k (Group)
+To create a kibozed group, use the @kbd{G k} command in the group
+buffer.
+
+The address field of the @code{nnkiboze} method is, as with
+@code{nnvirtual}, a regexp to match groups to be ``included'' in the
+@code{nnkiboze} group. That's where most similarities between @code{nnkiboze}
+and @code{nnvirtual} end.
+
+In addition to this regexp detailing component groups, an @code{nnkiboze} group
+must have a score file to say what articles are to be included in
+the group (@pxref{Scoring}).
+
+@kindex M-x nnkiboze-generate-groups
+@findex nnkiboze-generate-groups
+You must run @kbd{M-x nnkiboze-generate-groups} after creating the
+@code{nnkiboze} groups you want to have. This command will take time. Lots of
+time. Oodles and oodles of time. Gnus has to fetch the headers from
+all the articles in all the component groups and run them through the
+scoring process to determine if there are any articles in the groups
+that are to be part of the @code{nnkiboze} groups.
+
+Please limit the number of component groups by using restrictive
+regexps. Otherwise your sysadmin may become annoyed with you, and the
+@sc{nntp} site may throw you off and never let you back in again.
+Stranger things have happened.
+
+@code{nnkiboze} component groups do not have to be alive---they can be dead,
+and they can be foreign. No restrictions.
+
+@vindex nnkiboze-directory
+The generation of an @code{nnkiboze} group means writing two files in
+@code{nnkiboze-directory}, which is @file{~/News/} by default. One
+contains the @sc{nov} header lines for all the articles in the group,
+and the other is an additional @file{.newsrc} file to store information
+on what groups have been searched through to find component articles.
+
+Articles marked as read in the @code{nnkiboze} group will have
+their @sc{nov} lines removed from the @sc{nov} file.
+
+
+@node Gnus Unplugged
+@section Gnus Unplugged
+@cindex offline
+@cindex unplugged
+@cindex Agent
+@cindex Gnus Agent
+@cindex Gnus Unplugged
+
+In olden times (ca. February '88), people used to run their newsreaders
+on big machines with permanent connections to the net. News transport
+was dealt with by news servers, and all the newsreaders had to do was to
+read news. Believe it or not.
+
+Nowadays most people read news and mail at home, and use some sort of
+modem to connect to the net. To avoid running up huge phone bills, it
+would be nice to have a way to slurp down all the news and mail, hang up
+the phone, read for several hours, and then upload any responses you
+have to make. And then you repeat the procedure.
+
+Of course, you can use news servers for doing this as well. I've used
+@code{inn} together with @code{slurp}, @code{pop} and @code{sendmail}
+for some years, but doing that's a bore. Moving the news server
+functionality up to the newsreader makes sense if you're the only person
+reading news on a machine.
+
+Using Gnus as an ``offline'' newsreader is quite simple.
+
+@itemize @bullet
+@item
+First, set up Gnus as you would do if you were running it on a machine
+that has full connection to the net. Go ahead. I'll still be waiting
+here.
+
+@item
+Then, put the following magical incantation at the end of your
+@file{.gnus.el} file:
+
+@lisp
+(gnus-agentize)
+@end lisp
+@end itemize
+
+That's it. Gnus is now an ``offline'' newsreader.
+
+Of course, to use it as such, you have to learn a few new commands.
+
+@menu
+* Agent Basics:: How it all is supposed to work.
+* Agent Categories:: How to tell the Gnus Agent what to download.
+* Agent Commands:: New commands for all the buffers.
+* Outgoing Messages:: What happens when you post/mail something?
+* Agent Variables:: Customizing is fun.
+* Example Setup:: An example @file{.gnus.el} file for offline people.
+@end menu
+
+
+@node Agent Basics
+@subsection Agent Basics
+
+First, let's get some terminology out of the way.
+
+The Gnus Agent is said to be @dfn{unplugged} when you have severed the
+connection to the net (and notified the Agent that this is the case).
+When the connection to the net is up again (and Gnus knows this), the
+Agent is @dfn{plugged}.
+
+The @dfn{local} machine is the one you're running on, and which isn't
+connected to the net continously.
+
+@dfn{Downloading} means fetching things from the net to your local
+machine. @dfn{Uploading} is doing the opposite.
+
+Let's take a typical Gnus session using the Agent.
+
+@itemize @bullet
+
+@item
+You start Gnus with @code{gnus-unplugged}. This brings up the Gnus
+Agent in a disconnected state. You can read all the news that you have
+already fetched while in this mode.
+
+@item
+You then decide to see whether any new news has arrived. You connect
+your machine to the net (using PPP or whatever), and then hit @kbd{J j}
+to make Gnus become @dfn{plugged}.
+
+@item
+You can then read the new news immediately, or you can download the news
+onto your local machine. If you want to do the latter, you press @kbd{J
+s} to fetch all the eligible articles in all the groups. (To let Gnus
+know which articles you want to download, @pxref{Agent Categories}.)
+
+@item
+After fetching the articles, you press @kbd{J j} to make Gnus become
+unplugged again, and you shut down the PPP thing (or whatever). And
+then you read the news offline.
+
+@item
+And then you go to step 2.
+@end itemize
+
+Here are some things you should do the first time (or so) that you use
+the Agent.
+
+@itemize @bullet
+
+@item
+Decide which servers should be covered by the Agent. If you have a mail
+backend, it would probably be nonsensical to have it covered by the
+Agent. Go to the server buffer (@kbd{^} in the group buffer) and press
+@kbd{J a} the server (or servers) that you wish to have covered by the
+Agent (@pxref{Server Agent Commands}). This will typically be only the
+primary select method, which is listed on the bottom in the buffer.
+
+@item
+Decide on download policy. @xref{Agent Categories}
+
+@item
+Uhm... that's it.
+@end itemize
+
+
+@node Agent Categories
+@subsection Agent Categories
+
+One of the main reasons to integrate the news transport layer into the
+newsreader is to allow greater control over what articles to download.
+There's not much point in downloading huge amounts of articles, just to
+find out that you're not interested in reading any of them. It's better
+to be somewhat more conservative in choosing what to download, and then
+mark the articles for downloading manually if it should turn out that
+you're interested in the articles anyway.
+
+The main way to control what is to be downloaded is to create a
+@dfn{category} and then assign some (or all) groups to this category.
+Gnus has its own buffer for creating and managing categories.
+
+@menu
+* Category Syntax:: What a category looks like.
+* The Category Buffer:: A buffer for maintaining categories.
+* Category Variables:: Customize'r'Us.
+@end menu
+
+
+@node Category Syntax
+@subsubsection Category Syntax
+
+A category consists of two things.
+
+@enumerate
+@item
+A predicate which (generally) gives a rough outline of which articles
+are eligible for downloading; and
+
+@item
+a score rule which (generally) gives you a finer granularity when
+deciding what articles to download. (Note that this @dfn{download
+score} is wholly unrelated to normal scores.)
+@end enumerate
+
+A predicate consists of predicates with logical operators sprinkled in
+between.
+
+Perhaps some examples are in order.
+
+Here's a simple predicate. (It's the default predicate, in fact, used
+for all groups that don't belong to any other category.)
+
+@lisp
+short
+@end lisp
+
+Quite simple, eh? This predicate is true if and only if the article is
+short (for some value of ``short'').
+
+Here's a more complex predicate:
+
+@lisp
+(or high
+ (and
+ (not low)
+ (not long)))
+@end lisp
+
+This means that an article should be downloaded if it has a high score,
+or if the score is not low and the article is not long. You get the
+drift.
+
+The available logical operators are @code{or}, @code{and} and
+@code{not}. (If you prefer, you can use the more ``C''-ish operators
+@samp{|}, @code{&} and @code{!} instead.)
+
+The following predicates are pre-defined, but if none of these fit what
+you want to do, you can write your own.
+
+@table @code
+@item short
+True iff the article is shorter than @code{gnus-agent-short-article}
+lines; default 100.
+
+@item long
+True iff the article is longer than @code{gnus-agent-long-article}
+lines; default 200.
+
+@item low
+True iff the article has a download score less than
+@code{gnus-agent-low-score}; default 0.
+
+@item high
+True iff the article has a download score greater than
+@code{gnus-agent-high-score}; default 0.
+
+@item spam
+True iff the Gnus Agent guesses that the article is spam. The
+heuristics may change over time, but at present it just computes a
+checksum and sees whether articles match.
+
+@item true
+Always true.
+
+@item false
+Always false.
+@end table
+
+If you want to create your own predicate function, here's what you have
+to know: The functions are called with no parameters, but the
+@code{gnus-headers} and @code{gnus-score} dynamic variables are bound to
+useful values.
+
+Now, the syntax of the download score is the same as the syntax of
+normal score files, except that all elements that require actually
+seeing the article itself are verboten. This means that only the
+following headers can be scored on: @code{From}, @code{Subject},
+@code{Date}, @code{Xref}, @code{Lines}, @code{Chars}, @code{Message-ID},
+and @code{References}.
+
+
+@node The Category Buffer
+@subsubsection The Category Buffer
+
+You'd normally do all category maintenance from the category buffer.
+When you enter it for the first time (with the @kbd{J c} command from
+the group buffer), you'll only see the @code{default} category.
+
+The following commands are available in this buffer:
+
+@table @kbd
+@item q
+@kindex q (Category)
+@findex gnus-category-exit
+Return to the group buffer (@code{gnus-category-exit}).
+
+@item k
+@kindex k (Category)
+@findex gnus-category-kill
+Kill the current category (@code{gnus-category-kill}).
+
+@item c
+@kindex c (Category)
+@findex gnus-category-copy
+Copy the current category (@code{gnus-category-copy}).
+
+@item a
+@kindex a (Category)
+@findex gnus-category-add
+Add a new category (@code{gnus-category-add}).
+
+@item p
+@kindex p (Category)
+@findex gnus-category-edit-predicate
+Edit the predicate of the current category
+(@code{gnus-category-edit-predicate}).
+
+@item g
+@kindex g (Category)
+@findex gnus-category-edit-groups
+Edit the list of groups belonging to the current category
+(@code{gnus-category-edit-groups}).
+
+@item s
+@kindex s (Category)
+@findex gnus-category-edit-score
+Edit the download score rule of the current category
+(@code{gnus-category-edit-score}).
+
+@item l
+@kindex l (Category)
+@findex gnus-category-list
+List all the categories (@code{gnus-category-list}).
+@end table
+
+
+@node Category Variables
+@subsubsection Category Variables
+
+@table @code
+@item gnus-category-mode-hook
+@vindex gnus-category-mode-hook
+Hook run in category buffers.
+
+@item gnus-category-line-format
+@vindex gnus-category-line-format
+Format of the lines in the category buffer (@pxref{Formatting
+Variables}). Legal elements are:
+
+@table @samp
+@item c
+The name of the category.
+
+@item g
+The number of groups in the category.
+@end table
+
+@item gnus-category-mode-line-format
+@vindex gnus-category-mode-line-format
+Format of the category mode line.
+
+@item gnus-agent-short-article
+@vindex gnus-agent-short-article
+Articles that have fewer lines than this are short. Default 100.
+
+@item gnus-agent-long-article
+@vindex gnus-agent-long-article
+Articles that have more lines than this are long. Default 200.
+
+@item gnus-agent-low-score
+@vindex gnus-agent-low-score
+Articles that have a score lower than this have a low score. Default
+0.
+
+@item gnus-agent-high-score
+@vindex gnus-agent-high-score
+Articles that have a score higher than this have a high score. Default
+0.
+
+@end table
+
+
+@node Agent Commands
+@subsection Agent Commands
+
+All the Gnus Agent commands are on the @kbd{J} submap. The @kbd{J j}
+(@code{gnus-agent-toggle-plugged} command works in all modes, and
+toggles the plugged/unplugged state of the Gnus Agent.
+
+
+@menu
+* Group Agent Commands::
+* Summary Agent Commands::
+* Server Agent Commands::
+@end menu
+
+
+@node Group Agent Commands
+@subsubsection Group Agent Commands
+
+@table @kbd
+@item J u
+@kindex J u (Agent Group)
+@findex gnus-agent-fetch-group
+Fetch all eligible articles in the current group
+(@code{gnus-agent-fetch-group}).
+
+@item J c
+@kindex J c (Agent Group)
+@findex gnus-enter-category-buffer
+Enter the Agent category buffer (@code{gnus-enter-category-buffer}).
+
+@item J s
+@kindex J s (Agent Group)
+@findex gnus-agent-fetch-session
+Fetch all eligible articles in all groups
+(@code{gnus-agent-fetch-session}).
+
+@item J S
+@kindex J S (Agent Group)
+@findex gnus-group-send-drafts
+Send all sendable messages in the draft group
+(@code{gnus-agent-fetch-session}). @xref{Drafts}
+
+@item J a
+@kindex J a (Agent Group)
+@findex gnus-agent-add-group
+Add the current group to an Agent category
+(@code{gnus-agent-add-group}).
+
+@end table
+
+
+@node Summary Agent Commands
+@subsubsection Summary Agent Commands
+
+@table @kbd
+@item J #
+@kindex J # (Agent Summary)
+@findex gnus-agent-mark-article
+Mark the article for downloading (@code{gnus-agent-mark-article}).
+
+@item J M-#
+@kindex J M-# (Agent Summary)
+@findex gnus-agent-unmark-article
+Remove the downloading mark from the article
+(@code{gnus-agent-unmark-article}).
+
+@item @@
+@kindex @@ (Agent Summary)
+@findex gnus-agent-toggle-mark
+Toggle whether to download the article (@code{gnus-agent-toggle-mark}).
+
+@item J c
+@kindex J c (Agent Summary)
+@findex gnus-agent-catchup
+Mark all undownloaded articles as read (@code{gnus-agent-catchup}).
+
+@end table
+
+
+@node Server Agent Commands
+@subsubsection Server Agent Commands
+
+@table @kbd
+@item J a
+@kindex J a (Agent Server)
+@findex gnus-agent-add-server
+Add the current server to the list of servers covered by the Gnus Agent
+(@code{gnus-agent-add-server}).
+
+@item J r
+@kindex J r (Agent Server)
+@findex gnus-agent-remove-server
+Remove the current server from the list of servers covered by the Gnus
+Agent (@code{gnus-agent-remove-server}).
+
+@end table
+
+
+@node Outgoing Messages
+@subsection Outgoing Messages
+
+When Gnus is unplugged, all outgoing messages (both mail and news) are
+stored in the draft groups (@pxref{Drafts}). You can view them there
+after posting, and edit them at will.
+
+When Gnus is plugged again, you can send the messages either from the
+draft group with the special commands available there, or you can use
+the @kbd{J S} command in the group buffer to send all the sendable
+messages in the draft group.
+
+
+
+@node Agent Variables
+@subsection Agent Variables
+
+@table @code
+@item gnus-agent-directory
+@vindex gnus-agent-directory
+Where the Gnus Agent will store its files. The default is
+@file{~/News/agent/}.
+
+@item gnus-agent-plugged-hook
+@vindex gnus-agent-plugged-hook
+Hook run when connecting to the network.
+
+@item gnus-agent-unplugged-hook
+@vindex gnus-agent-unplugged-hook
+Hook run when disconnecting from the network.
+
+@end table
+
+
+@node Example Setup
+@subsection Example Setup
+
+If you don't want to read this manual, and you have a fairly standard
+setup, you may be able to use something like the following as your
+@file{.gnus.el} file to get started.
+
+@lisp
+;;; Define how Gnus is to fetch news. We do this over NNTP
+;;; from your ISP's server.
+(setq gnus-select-method '(nntp "nntp.your-isp.com"))
+
+;;; Define how Gnus is to read your mail. We read mail from
+;;; your ISP's POP server.
+(setenv "MAILHOST" "pop.your-isp.com")
+(setq nnmail-spool-file "po:username")
+
+;;; Say how Gnus is to store the mail. We use nnml groups.
+(setq gnus-secondary-select-methods '((nnml "")))
+
+;;; Make Gnus into an offline newsreader.
+(gnus-agentize)
+@end lisp
+
+That should be it, basically. Put that in your @file{~/.gnus.el} file,
+edit to suit your needs, start up PPP (or whatever), and type @kbd{M-x
+gnus}.
+
+If this is the first time you've run Gnus, you will be subscribed
+automatically to a few default newsgroups. You'll probably want to
+subscribe to more groups, and to do that, you have to query the
+@sc{nntp} server for a complete list of groups with the @kbd{A A}
+command. This usually takes quite a while, but you only have to do it
+once.
+
+After reading and parsing a while, you'll be presented with a list of
+groups. Subscribe to the ones you want to read with the @kbd{u}
+command. @kbd{l} to make all the killed groups disappear after you've
+subscribe to all the groups you want to read. (@kbd{A k} will bring
+back all the killed groups.)
+
+You can now read the groups at once, or you can download the articles
+with the @kbd{J s} command. And then read the rest of this manual to
+find out which of the other gazillion things you want to customize.
+
+
+@node Scoring
+@chapter Scoring
+@cindex scoring
+
+Other people use @dfn{kill files}, but we here at Gnus Towers like
+scoring better than killing, so we'd rather switch than fight. They do
+something completely different as well, so sit up straight and pay
+attention!
+
+@vindex gnus-summary-mark-below
+All articles have a default score (@code{gnus-summary-default-score}),
+which is 0 by default. This score may be raised or lowered either
+interactively or by score files. Articles that have a score lower than
+@code{gnus-summary-mark-below} are marked as read.
+
+Gnus will read any @dfn{score files} that apply to the current group
+before generating the summary buffer.
+
+There are several commands in the summary buffer that insert score
+entries based on the current article. You can, for instance, ask Gnus to
+lower or increase the score of all articles with a certain subject.
+
+There are two sorts of scoring entries: Permanent and temporary.
+Temporary score entries are self-expiring entries. Any entries that are
+temporary and have not been used for, say, a week, will be removed
+silently to help keep the sizes of the score files down.
+
+@menu
+* Summary Score Commands:: Adding score entries for the current group.
+* Group Score Commands:: General score commands.
+* Score Variables:: Customize your scoring. (My, what terminology).
+* Score File Format:: What a score file may contain.
+* Score File Editing:: You can edit score files by hand as well.
+* Adaptive Scoring:: Big Sister Gnus knows what you read.
+* Home Score File:: How to say where new score entries are to go.
+* Followups To Yourself:: Having Gnus notice when people answer you.
+* Scoring Tips:: How to score effectively.
+* Reverse Scoring:: That problem child of old is not problem.
+* Global Score Files:: Earth-spanning, ear-splitting score files.
+* Kill Files:: They are still here, but they can be ignored.
+* Converting Kill Files:: Translating kill files to score files.
+* GroupLens:: Getting predictions on what you like to read.
+* Advanced Scoring:: Using logical expressions to build score rules.
+* Score Decays:: It can be useful to let scores wither away.
+@end menu
+
+
+@node Summary Score Commands
+@section Summary Score Commands
+@cindex score commands
+
+The score commands that alter score entries do not actually modify real
+score files. That would be too inefficient. Gnus maintains a cache of
+previously loaded score files, one of which is considered the
+@dfn{current score file alist}. The score commands simply insert
+entries into this list, and upon group exit, this list is saved.
+
+The current score file is by default the group's local score file, even
+if no such score file actually exists. To insert score commands into
+some other score file (e.g. @file{all.SCORE}), you must first make this
+score file the current one.
+
+General score commands that don't actually change the score file:
+
+@table @kbd
+
+@item V s
+@kindex V s (Summary)
+@findex gnus-summary-set-score
+Set the score of the current article (@code{gnus-summary-set-score}).
+
+@item V S
+@kindex V S (Summary)
+@findex gnus-summary-current-score
+Display the score of the current article
+(@code{gnus-summary-current-score}).
+
+@item V t
+@kindex V t (Summary)
+@findex gnus-score-find-trace
+Display all score rules that have been used on the current article
+(@code{gnus-score-find-trace}).
+
+@item V R
+@kindex V R (Summary)
+@findex gnus-summary-rescore
+Run the current summary through the scoring process
+(@code{gnus-summary-rescore}). This might be useful if you're playing
+around with your score files behind Gnus' back and want to see the
+effect you're having.
+
+@item V a
+@kindex V a (Summary)
+@findex gnus-summary-score-entry
+Add a new score entry, and allow specifying all elements
+(@code{gnus-summary-score-entry}).
+
+@item V c
+@kindex V c (Summary)
+@findex gnus-score-change-score-file
+Make a different score file the current
+(@code{gnus-score-change-score-file}).
+
+@item V e
+@kindex V e (Summary)
+@findex gnus-score-edit-current-scores
+Edit the current score file (@code{gnus-score-edit-current-scores}).
+You will be popped into a @code{gnus-score-mode} buffer (@pxref{Score
+File Editing}).
+
+@item V f
+@kindex V f (Summary)
+@findex gnus-score-edit-file
+Edit a score file and make this score file the current one
+(@code{gnus-score-edit-file}).
+
+@item V F
+@kindex V F (Summary)
+@findex gnus-score-flush-cache
+Flush the score cache (@code{gnus-score-flush-cache}). This is useful
+after editing score files.
+
+@item V C
+@kindex V C (Summary)
+@findex gnus-score-customize
+Customize a score file in a visually pleasing manner
+(@code{gnus-score-customize}).
+
+@end table
+
+The rest of these commands modify the local score file.
+
+@table @kbd
+
+@item V m
+@kindex V m (Summary)
+@findex gnus-score-set-mark-below
+Prompt for a score, and mark all articles with a score below this as
+read (@code{gnus-score-set-mark-below}).
+
+@item V x
+@kindex V x (Summary)
+@findex gnus-score-set-expunge-below
+Prompt for a score, and add a score rule to the current score file to
+expunge all articles below this score
+(@code{gnus-score-set-expunge-below}).
+@end table
+
+The keystrokes for actually making score entries follow a very regular
+pattern, so there's no need to list all the commands. (Hundreds of
+them.)
+
+@findex gnus-summary-increase-score
+@findex gnus-summary-lower-score
+
+@enumerate
+@item
+The first key is either @kbd{I} (upper case i) for increasing the score
+or @kbd{L} for lowering the score.
+@item
+The second key says what header you want to score on. The following
+keys are available:
+@table @kbd
+
+@item a
+Score on the author name.
+
+@item s
+Score on the subject line.
+
+@item x
+Score on the Xref line---i.e., the cross-posting line.
+
+@item t
+Score on thread---the References line.
+
+@item d
+Score on the date.
+
+@item l
+Score on the number of lines.
+
+@item i
+Score on the Message-ID.
+
+@item f
+Score on followups.
+
+@item b
+Score on the body.
+
+@item h
+Score on the head.
+@end table
+
+@item
+The third key is the match type. Which match types are valid depends on
+what headers you are scoring on.
+
+@table @code
+
+@item strings
+
+@table @kbd
+
+@item e
+Exact matching.
+
+@item s
+Substring matching.
+
+@item f
+Fuzzy matching (@pxref{Fuzzy Matching}).
+
+@item r
+Regexp matching
+@end table
+
+@item date
+@table @kbd
+
+@item b
+Before date.
+
+@item a
+At date.
+
+@item n
+This date.
+@end table
+
+@item number
+@table @kbd
+
+@item <
+Less than number.
+
+@item =
+Equal to number.
+
+@item >
+Greater than number.
+@end table
+@end table
+
+@item
+The fourth and final key says whether this is a temporary (i.e., expiring)
+score entry, or a permanent (i.e., non-expiring) score entry, or whether
+it is to be done immediately, without adding to the score file.
+@table @kbd
+
+@item t
+Temporary score entry.
+
+@item p
+Permanent score entry.
+
+@item i
+Immediately scoring.
+@end table
+
+@end enumerate
+
+So, let's say you want to increase the score on the current author with
+exact matching permanently: @kbd{I a e p}. If you want to lower the
+score based on the subject line, using substring matching, and make a
+temporary score entry: @kbd{L s s t}. Pretty easy.
+
+To make things a bit more complicated, there are shortcuts. If you use
+a capital letter on either the second or third keys, Gnus will use
+defaults for the remaining one or two keystrokes. The defaults are
+``substring'' and ``temporary''. So @kbd{I A} is the same as @kbd{I a s
+t}, and @kbd{I a R} is the same as @kbd{I a r t}.
+
+These functions take both the numerical prefix and the symbolic prefix
+(@pxref{Symbolic Prefixes}). A numerical prefix says how much to lower
+(or increase) the score of the article. A symbolic prefix of @code{a}
+says to use the @file{all.SCORE} file for the command instead of the
+current score file.
+
+@vindex gnus-score-mimic-keymap
+The @code{gnus-score-mimic-keymap} says whether these commands will
+pretend they are keymaps or not.
+
+
+@node Group Score Commands
+@section Group Score Commands
+@cindex group score commands
+
+There aren't many of these as yet, I'm afraid.
+
+@table @kbd
+
+@item W f
+@kindex W f (Group)
+@findex gnus-score-flush-cache
+Gnus maintains a cache of score alists to avoid having to reload them
+all the time. This command will flush the cache
+(@code{gnus-score-flush-cache}).
+
+@end table
+
+
+@node Score Variables
+@section Score Variables
+@cindex score variables
+
+@table @code
+
+@item gnus-use-scoring
+@vindex gnus-use-scoring
+If @code{nil}, Gnus will not check for score files, and will not, in
+general, do any score-related work. This is @code{t} by default.
+
+@item gnus-kill-killed
+@vindex gnus-kill-killed
+If this variable is @code{nil}, Gnus will never apply score files to
+articles that have already been through the kill process. While this
+may save you lots of time, it also means that if you apply a kill file
+to a group, and then change the kill file and want to run it over you
+group again to kill more articles, it won't work. You have to set this
+variable to @code{t} to do that. (It is @code{t} by default.)
+
+@item gnus-kill-files-directory
+@vindex gnus-kill-files-directory
+All kill and score files will be stored in this directory, which is
+initialized from the @code{SAVEDIR} environment variable by default.
+This is @file{~/News/} by default.
+
+@item gnus-score-file-suffix
+@vindex gnus-score-file-suffix
+Suffix to add to the group name to arrive at the score file name
+(@samp{SCORE} by default.)
+
+@item gnus-score-uncacheable-files
+@vindex gnus-score-uncacheable-files
+@cindex score cache
+All score files are normally cached to avoid excessive re-loading of
+score files. However, if this might make you Emacs grow big and
+bloated, so this regexp can be used to weed out score files unlikely to be needed again. It would be a bad idea to deny caching of
+@file{all.SCORE}, while it might be a good idea to not cache
+@file{comp.infosystems.www.authoring.misc.ADAPT}. In fact, this
+variable is @samp{ADAPT$} by default, so no adaptive score files will
+be cached.
+
+@item gnus-save-score
+@vindex gnus-save-score
+If you have really complicated score files, and do lots of batch
+scoring, then you might set this variable to @code{t}. This will make
+Gnus save the scores into the @file{.newsrc.eld} file.
+
+@item gnus-score-interactive-default-score
+@vindex gnus-score-interactive-default-score
+Score used by all the interactive raise/lower commands to raise/lower
+score with. Default is 1000, which may seem excessive, but this is to
+ensure that the adaptive scoring scheme gets enough room to play with.
+We don't want the small changes from the adaptive scoring to overwrite
+manually entered data.
+
+@item gnus-summary-default-score
+@vindex gnus-summary-default-score
+Default score of an article, which is 0 by default.
+
+@item gnus-summary-expunge-below
+@vindex gnus-summary-expunge-below
+Don't display the summary lines of articles that have scores lower than
+this variable. This is @code{nil} by default, which means that no
+articles will be hidden.
+
+@item gnus-score-over-mark
+@vindex gnus-score-over-mark
+Mark (in the third column) used for articles with a score over the
+default. Default is @samp{+}.
+
+@item gnus-score-below-mark
+@vindex gnus-score-below-mark
+Mark (in the third column) used for articles with a score below the
+default. Default is @samp{-}.
+
+@item gnus-score-find-score-files-function
+@vindex gnus-score-find-score-files-function
+Function used to find score files for the current group. This function
+is called with the name of the group as the argument.
+
+Predefined functions available are:
+@table @code
+
+@item gnus-score-find-single
+@findex gnus-score-find-single
+Only apply the group's own score file.
+
+@item gnus-score-find-bnews
+@findex gnus-score-find-bnews
+Apply all score files that match, using bnews syntax. This is the
+default. If the current group is @samp{gnu.emacs.gnus}, for instance,
+@file{all.emacs.all.SCORE}, @file{not.alt.all.SCORE} and
+@file{gnu.all.SCORE} would all apply. In short, the instances of
+@samp{all} in the score file names are translated into @samp{.+}, and
+then a regexp match is done.
+
+This means that if you have some score entries that you want to apply to
+all groups, then you put those entries in the @file{all.SCORE} file.
+
+The score files are applied in a semi-random order, although Gnus will
+try to apply the more general score files before the more specific score
+files. It does this by looking at the number of elements in the score
+file names---discarding the @samp{all} elements.
+
+@item gnus-score-find-hierarchical
+@findex gnus-score-find-hierarchical
+Apply all score files from all the parent groups. This means that you
+can't have score files like @file{all.SCORE}, but you can have
+@file{SCORE}, @file{comp.SCORE} and @file{comp.emacs.SCORE}.
+
+@end table
+This variable can also be a list of functions. In that case, all these
+functions will be called, and all the returned lists of score files will
+be applied. These functions can also return lists of score alists
+directly. In that case, the functions that return these non-file score
+alists should probably be placed before the ``real'' score file
+functions, to ensure that the last score file returned is the local
+score file. Phu.
+
+@item gnus-score-expiry-days
+@vindex gnus-score-expiry-days
+This variable says how many days should pass before an unused score file
+entry is expired. If this variable is @code{nil}, no score file entries
+are expired. It's 7 by default.
+
+@item gnus-update-score-entry-dates
+@vindex gnus-update-score-entry-dates
+If this variable is non-@code{nil}, matching score entries will have
+their dates updated. (This is how Gnus controls expiry---all
+non-matching entries will become too old while matching entries will
+stay fresh and young.) However, if you set this variable to @code{nil},
+even matching entries will grow old and will have to face that oh-so
+grim reaper.
+
+@item gnus-score-after-write-file-function
+@vindex gnus-score-after-write-file-function
+Function called with the name of the score file just written.
+
+@end table
+
+
+@node Score File Format
+@section Score File Format
+@cindex score file format
+
+A score file is an @code{emacs-lisp} file that normally contains just a
+single form. Casual users are not expected to edit these files;
+everything can be changed from the summary buffer.
+
+Anyway, if you'd like to dig into it yourself, here's an example:
+
+@lisp
+(("from"
+ ("Lars Ingebrigtsen" -10000)
+ ("Per Abrahamsen")
+ ("larsi\\|lmi" -50000 nil R))
+ ("subject"
+ ("Ding is Badd" nil 728373))
+ ("xref"
+ ("alt.politics" -1000 728372 s))
+ ("lines"
+ (2 -100 nil <))
+ (mark 0)
+ (expunge -1000)
+ (mark-and-expunge -10)
+ (read-only nil)
+ (orphan -10)
+ (adapt t)
+ (files "/hom/larsi/News/gnu.SCORE")
+ (exclude-files "all.SCORE")
+ (local (gnus-newsgroup-auto-expire t)
+ (gnus-summary-make-false-root empty))
+ (eval (ding)))
+@end lisp
+
+This example demonstrates most score file elements. For a different
+approach, see @pxref{Advanced Scoring}.
+
+Even though this looks much like lisp code, nothing here is actually
+@code{eval}ed. The lisp reader is used to read this form, though, so it
+has to be valid syntactically, if not semantically.
+
+Six keys are supported by this alist:
+
+@table @code
+
+@item STRING
+If the key is a string, it is the name of the header to perform the
+match on. Scoring can only be performed on these eight headers:
+@code{From}, @code{Subject}, @code{References}, @code{Message-ID},
+@code{Xref}, @code{Lines}, @code{Chars} and @code{Date}. In addition to
+these headers, there are three strings to tell Gnus to fetch the entire
+article and do the match on larger parts of the article: @code{Body}
+will perform the match on the body of the article, @code{Head} will
+perform the match on the head of the article, and @code{All} will
+perform the match on the entire article. Note that using any of these
+last three keys will slow down group entry @emph{considerably}. The
+final ``header'' you can score on is @code{Followup}. These score
+entries will result in new score entries being added for all follow-ups
+to articles that matches these score entries.
+
+Following this key is a arbitrary number of score entries, where each
+score entry has one to four elements.
+@enumerate
+
+@item
+The first element is the @dfn{match element}. On most headers this will
+be a string, but on the Lines and Chars headers, this must be an
+integer.
+
+@item
+If the second element is present, it should be a number---the @dfn{score
+element}. This number should be an integer in the neginf to posinf
+interval. This number is added to the score of the article if the match
+is successful. If this element is not present, the
+@code{gnus-score-interactive-default-score} number will be used
+instead. This is 1000 by default.
+
+@item
+If the third element is present, it should be a number---the @dfn{date
+element}. This date says when the last time this score entry matched,
+which provides a mechanism for expiring the score entries. It this
+element is not present, the score entry is permanent. The date is
+represented by the number of days since December 31, 1 BCE.
+
+@item
+If the fourth element is present, it should be a symbol---the @dfn{type
+element}. This element specifies what function should be used to see
+whether this score entry matches the article. What match types that can
+be used depends on what header you wish to perform the match on.
+@table @dfn
+
+@item From, Subject, References, Xref, Message-ID
+For most header types, there are the @code{r} and @code{R} (regexp), as
+well as @code{s} and @code{S} (substring) types, and @code{e} and
+@code{E} (exact match), and @code{w} (word match) types. If this
+element is not present, Gnus will assume that substring matching should
+be used. @code{R}, @code{S}, and @code{E} differ from the others in
+that the matches will be done in a case-sensitive manner. All these
+one-letter types are really just abbreviations for the @code{regexp},
+@code{string}, @code{exact}, and @code{word} types, which you can use
+instead, if you feel like.
+
+@item Lines, Chars
+These two headers use different match types: @code{<}, @code{>},
+@code{=}, @code{>=} and @code{<=}. When matching on @code{Lines}, be
+careful because some backends (like @code{nndir}) do not generate
+@code{Lines} header, so every article ends up being marked as having 0
+lines. This can lead to strange results if you happen to lower score of
+the articles with few lines.
+
+@item Date
+For the Date header we have three kinda silly match types:
+@code{before}, @code{at} and @code{after}. I can't really imagine this
+ever being useful, but, like, it would feel kinda silly not to provide
+this function. Just in case. You never know. Better safe than sorry.
+Once burnt, twice shy. Don't judge a book by its cover. Never not have
+sex on a first date. (I have been told that at least one person, and I
+quote, ``found this function indispensable'', however.)
+
+@cindex ISO8601
+@cindex date
+A more useful match type is @code{regexp}. With it, you can match the
+date string using a regular expression. The date is normalized to
+ISO8601 compact format first---@var{YYYYMMDD}@code{T}@var{HHMMSS}. If
+you want to match all articles that have been posted on April 1st in
+every year, you could use @samp{....0401.........} as a match string,
+for instance. (Note that the date is kept in its original time zone, so
+this will match articles that were posted when it was April 1st where
+the article was posted from. Time zones are such wholesome fun for the
+whole family, eh?)
+
+@item Head, Body, All
+These three match keys use the same match types as the @code{From} (etc)
+header uses.
+
+@item Followup
+This match key is somewhat special, in that it will match the
+@code{From} header, and affect the score of not only the matching
+articles, but also all followups to the matching articles. This allows
+you e.g. increase the score of followups to your own articles, or
+decrease the score of followups to the articles of some known
+trouble-maker. Uses the same match types as the @code{From} header
+uses. (Using this match key will lead to creation of @file{ADAPT}
+files.)
+
+@item Thread
+This match key works along the same lines as the @code{Followup} match
+key. If you say that you want to score on a (sub-)thread started by an article with a @code{Message-ID} @var{X}, then you add a
+@samp{thread} match. This will add a new @samp{thread} match for each
+article that has @var{X} in its @code{References} header. (These new
+@samp{thread} matches will use the @code{Message-ID}s of these matching
+articles.) This will ensure that you can raise/lower the score of an
+entire thread, even though some articles in the thread may not have
+complete @code{References} headers. Note that using this may lead to
+undeterministic scores of the articles in the thread. (Using this match
+key will lead to creation of @file{ADAPT} files.)
+@end table
+@end enumerate
+
+@cindex Score File Atoms
+@item mark
+The value of this entry should be a number. Any articles with a score
+lower than this number will be marked as read.
+
+@item expunge
+The value of this entry should be a number. Any articles with a score
+lower than this number will be removed from the summary buffer.
+
+@item mark-and-expunge
+The value of this entry should be a number. Any articles with a score
+lower than this number will be marked as read and removed from the
+summary buffer.
+
+@item thread-mark-and-expunge
+The value of this entry should be a number. All articles that belong to
+a thread that has a total score below this number will be marked as read
+and removed from the summary buffer. @code{gnus-thread-score-function}
+says how to compute the total score for a thread.
+
+@item files
+The value of this entry should be any number of file names. These files
+are assumed to be score files as well, and will be loaded the same way
+this one was.
+
+@item exclude-files
+The clue of this entry should be any number of files. These files will
+not be loaded, even though they would normally be so, for some reason or
+other.
+
+@item eval
+The value of this entry will be @code{eval}el. This element will be
+ignored when handling global score files.
+
+@item read-only
+Read-only score files will not be updated or saved. Global score files
+should feature this atom (@pxref{Global Score Files}).
+
+@item orphan
+The value of this entry should be a number. Articles that do not have
+parents will get this number added to their scores. Imagine you follow
+some high-volume newsgroup, like @samp{comp.lang.c}. Most likely you
+will only follow a few of the threads, also want to see any new threads.
+
+You can do this with the following two score file entries:
+
+@example
+ (orphan -500)
+ (mark-and-expunge -100)
+@end example
+
+When you enter the group the first time, you will only see the new
+threads. You then raise the score of the threads that you find
+interesting (with @kbd{I T} or @kbd{I S}), and ignore (@kbd{C y}) the
+rest. Next time you enter the group, you will see new articles in the
+interesting threads, plus any new threads.
+
+I.e.---the orphan score atom is for high-volume groups where there
+exist a few interesting threads which can't be found automatically by
+ordinary scoring rules.
+
+@item adapt
+This entry controls the adaptive scoring. If it is @code{t}, the
+default adaptive scoring rules will be used. If it is @code{ignore}, no
+adaptive scoring will be performed on this group. If it is a list, this
+list will be used as the adaptive scoring rules. If it isn't present,
+or is something other than @code{t} or @code{ignore}, the default
+adaptive scoring rules will be used. If you want to use adaptive
+scoring on most groups, you'd set @code{gnus-use-adaptive-scoring} to
+@code{t}, and insert an @code{(adapt ignore)} in the groups where you do
+not want adaptive scoring. If you only want adaptive scoring in a few
+groups, you'd set @code{gnus-use-adaptive-scoring} to @code{nil}, and
+insert @code{(adapt t)} in the score files of the groups where you want
+it.
+
+@item adapt-file
+All adaptive score entries will go to the file named by this entry. It
+will also be applied when entering the group. This atom might be handy
+if you want to adapt on several groups at once, using the same adaptive
+file for a number of groups.
+
+@item local
+@cindex local variables
+The value of this entry should be a list of @code{(VAR VALUE)} pairs.
+Each @var{var} will be made buffer-local to the current summary buffer,
+and set to the value specified. This is a convenient, if somewhat
+strange, way of setting variables in some groups if you don't like hooks
+much. Note that the @var{value} won't be evaluated.
+@end table
+
+
+@node Score File Editing
+@section Score File Editing
+
+You normally enter all scoring commands from the summary buffer, but you
+might feel the urge to edit them by hand as well, so we've supplied you
+with a mode for that.
+
+It's simply a slightly customized @code{emacs-lisp} mode, with these
+additional commands:
+
+@table @kbd
+
+@item C-c C-c
+@kindex C-c C-c (Score)
+@findex gnus-score-edit-done
+Save the changes you have made and return to the summary buffer
+(@code{gnus-score-edit-done}).
+
+@item C-c C-d
+@kindex C-c C-d (Score)
+@findex gnus-score-edit-insert-date
+Insert the current date in numerical format
+(@code{gnus-score-edit-insert-date}). This is really the day number, if
+you were wondering.
+
+@item C-c C-p
+@kindex C-c C-p (Score)
+@findex gnus-score-pretty-print
+The adaptive score files are saved in an unformatted fashion. If you
+intend to read one of these files, you want to @dfn{pretty print} it
+first. This command (@code{gnus-score-pretty-print}) does that for
+you.
+
+@end table
+
+Type @kbd{M-x gnus-score-mode} to use this mode.
+
+@vindex gnus-score-mode-hook
+@code{gnus-score-menu-hook} is run in score mode buffers.
+
+In the summary buffer you can use commands like @kbd{V f} and @kbd{V
+e} to begin editing score files.
+
+
+@node Adaptive Scoring
+@section Adaptive Scoring
+@cindex adaptive scoring
+
+If all this scoring is getting you down, Gnus has a way of making it all
+happen automatically---as if by magic. Or rather, as if by artificial
+stupidity, to be precise.
+
+@vindex gnus-use-adaptive-scoring
+When you read an article, or mark an article as read, or kill an
+article, you leave marks behind. On exit from the group, Gnus can sniff
+these marks and add score elements depending on what marks it finds.
+You turn on this ability by setting @code{gnus-use-adaptive-scoring} to
+@code{t} or @code{(line)}. If you want score adaptively on separate
+words appearing in the subjects, you should set this variable to
+@code{(word)}. If you want to use both adaptive methods, set this
+variable to @code{(word line)}.
+
+@vindex gnus-default-adaptive-score-alist
+To give you complete control over the scoring process, you can customize
+the @code{gnus-default-adaptive-score-alist} variable. For instance, it
+might look something like this:
+
+@lisp
+(defvar gnus-default-adaptive-score-alist
+ '((gnus-unread-mark)
+ (gnus-ticked-mark (from 4))
+ (gnus-dormant-mark (from 5))
+ (gnus-del-mark (from -4) (subject -1))
+ (gnus-read-mark (from 4) (subject 2))
+ (gnus-expirable-mark (from -1) (subject -1))
+ (gnus-killed-mark (from -1) (subject -3))
+ (gnus-kill-file-mark)
+ (gnus-ancient-mark)
+ (gnus-low-score-mark)
+ (gnus-catchup-mark (from -1) (subject -1))))
+@end lisp
+
+As you see, each element in this alist has a mark as a key (either a
+variable name or a ``real'' mark---a character). Following this key is
+a arbitrary number of header/score pairs. If there are no header/score
+pairs following the key, no adaptive scoring will be done on articles
+that have that key as the article mark. For instance, articles with
+@code{gnus-unread-mark} in the example above will not get adaptive score
+entries.
+
+Each article can have only one mark, so just a single of these rules
+will be applied to each article.
+
+To take @code{gnus-del-mark} as an example---this alist says that all
+articles that have that mark (i.e., are marked with @samp{D}) will have a
+score entry added to lower based on the @code{From} header by -4, and
+lowered by @code{Subject} by -1. Change this to fit your prejudices.
+
+If you have marked 10 articles with the same subject with
+@code{gnus-del-mark}, the rule for that mark will be applied ten times.
+That means that that subject will get a score of ten times -1, which
+should be, unless I'm much mistaken, -10.
+
+If you have auto-expirable (mail) groups (@pxref{Expiring Mail}), all
+the read articles will be marked with the @samp{E} mark. This'll
+probably make adaptive scoring slightly impossible, so auto-expiring and
+adaptive scoring doesn't really mix very well.
+
+The headers you can score on are @code{from}, @code{subject},
+@code{message-id}, @code{references}, @code{xref}, @code{lines},
+@code{chars} and @code{date}. In addition, you can score on
+@code{followup}, which will create an adaptive score entry that matches
+on the @code{References} header using the @code{Message-ID} of the
+current article, thereby matching the following thread.
+
+You can also score on @code{thread}, which will try to score all
+articles that appear in a thread. @code{thread} matches uses a
+@code{Message-ID} to match on the @code{References} header of the
+article. If the match is made, the @code{Message-ID} of the article is
+added to the @code{thread} rule. (Think about it. I'd recommend two
+aspirins afterwards.)
+
+If you use this scheme, you should set the score file atom @code{mark}
+to something small---like -300, perhaps, to avoid having small random
+changes result in articles getting marked as read.
+
+After using adaptive scoring for a week or so, Gnus should start to
+become properly trained and enhance the authors you like best, and kill
+the authors you like least, without you having to say so explicitly.
+
+You can control what groups the adaptive scoring is to be performed on
+by using the score files (@pxref{Score File Format}). This will also
+let you use different rules in different groups.
+
+@vindex gnus-adaptive-file-suffix
+The adaptive score entries will be put into a file where the name is the
+group name with @code{gnus-adaptive-file-suffix} appended. The default
+is @samp{ADAPT}.
+
+@vindex gnus-score-exact-adapt-limit
+When doing adaptive scoring, substring or fuzzy matching would probably
+give you the best results in most cases. However, if the header one
+matches is short, the possibility for false positives is great, so if
+the length of the match is less than
+@code{gnus-score-exact-adapt-limit}, exact matching will be used. If
+this variable is @code{nil}, exact matching will always be used to avoid
+this problem.
+
+@vindex gnus-default-adaptive-word-score-alist
+As mentioned above, you can adapt either on individual words or entire
+headers. If you adapt on words, the
+@code{gnus-default-adaptive-word-score-alist} variable says what score
+each instance of a word should add given a mark.
+
+@lisp
+(setq gnus-default-adaptive-word-score-alist
+ `((,gnus-read-mark . 30)
+ (,gnus-catchup-mark . -10)
+ (,gnus-killed-mark . -20)
+ (,gnus-del-mark . -15)))
+@end lisp
+
+This is the default value. If you have adaption on words enabled, every
+word that appears in subjects of articles marked with
+@code{gnus-read-mark} will result in a score rule that increase the
+score with 30 points.
+
+@vindex gnus-default-ignored-adaptive-words
+@vindex gnus-ignored-adaptive-words
+Words that appear in the @code{gnus-default-ignored-adaptive-words} list
+will be ignored. If you wish to add more words to be ignored, use the
+@code{gnus-ignored-adaptive-words} list instead.
+
+@vindex gnus-adaptive-word-syntax-table
+When the scoring is done, @code{gnus-adaptive-word-syntax-table} is the
+syntax table in effect. It is similar to the standard syntax table, but
+it considers numbers to be non-word-constituent characters.
+
+After using this scheme for a while, it might be nice to write a
+@code{gnus-psychoanalyze-user} command to go through the rules and see
+what words you like and what words you don't like. Or perhaps not.
+
+Note that the adaptive word scoring thing is highly experimental and is
+likely to change in the future. Initial impressions seem to indicate
+that it's totally useless as it stands. Some more work (involving more
+rigorous statistical methods) will have to be done to make this useful.
+
+
+@node Home Score File
+@section Home Score File
+
+The score file where new score file entries will go is called the
+@dfn{home score file}. This is normally (and by default) the score file
+for the group itself. For instance, the home score file for
+@samp{gnu.emacs.gnus} is @file{gnu.emacs.gnus.SCORE}.
+
+However, this may not be what you want. It is often convenient to share
+a common home score file among many groups---all @samp{emacs} groups
+could perhaps use the same home score file.
+
+@vindex gnus-home-score-file
+The variable that controls this is @code{gnus-home-score-file}. It can
+be:
+
+@enumerate
+@item
+A string. Then this file will be used as the home score file for all
+groups.
+
+@item
+A function. The result of this function will be used as the home score
+file. The function will be called with the name of the group as the
+parameter.
+
+@item
+A list. The elements in this list can be:
+
+@enumerate
+@item
+@var{(regexp file-name)}. If the @var{regexp} matches the group name,
+the @var{file-name} will will be used as the home score file.
+
+@item
+A function. If the function returns non-nil, the result will be used as
+the home score file.
+
+@item
+A string. Use the string as the home score file.
+@end enumerate
+
+The list will be traversed from the beginning towards the end looking
+for matches.
+
+@end enumerate
+
+So, if you want to use just a single score file, you could say:
+
+@lisp
+(setq gnus-home-score-file
+ "my-total-score-file.SCORE")
+@end lisp
+
+If you want to use @file{gnu.SCORE} for all @samp{gnu} groups and
+@file{rec.SCORE} for all @samp{rec} groups (and so on), you can say:
+
+@lisp
+(setq gnus-home-score-file
+ 'gnus-hierarchial-home-score-file)
+@end lisp
+
+This is a ready-made function provided for your convenience.
+
+If you want to have one score file for the @samp{emacs} groups and
+another for the @samp{comp} groups, while letting all other groups use
+their own home score files:
+
+@lisp
+(setq gnus-home-score-file
+ ;; All groups that match the regexp "\\.emacs"
+ '("\\.emacs" "emacs.SCORE")
+ ;; All the comp groups in one score file
+ ("^comp" "comp.SCORE"))
+@end lisp
+
+@vindex gnus-home-adapt-file
+@code{gnus-home-adapt-file} works exactly the same way as
+@code{gnus-home-score-file}, but says what the home adaptive score file
+is instead. All new adaptive file entries will go into the file
+specified by this variable, and the same syntax is allowed.
+
+In addition to using @code{gnus-home-score-file} and
+@code{gnus-home-adapt-file}, you can also use group parameters
+(@pxref{Group Parameters}) and topic parameters (@pxref{Topic
+Parameters}) to achieve much the same. Group and topic parameters take
+precedence over this variable.
+
+
+@node Followups To Yourself
+@section Followups To Yourself
+
+Gnus offers two commands for picking out the @code{Message-ID} header in
+the current buffer. Gnus will then add a score rule that scores using
+this @code{Message-ID} on the @code{References} header of other
+articles. This will, in effect, increase the score of all articles that
+respond to the article in the current buffer. Quite useful if you want
+to easily note when people answer what you've said.
+
+@table @code
+
+@item gnus-score-followup-article
+@findex gnus-score-followup-article
+This will add a score to articles that directly follow up your own
+article.
+
+@item gnus-score-followup-thread
+@findex gnus-score-followup-thread
+This will add a score to all articles that appear in a thread ``below''
+your own article.
+@end table
+
+@vindex message-sent-hook
+These two functions are both primarily meant to be used in hooks like
+@code{message-sent-hook}.
+
+If you look closely at your own @code{Message-ID}, you'll notice that
+the first two or three characters are always the same. Here's two of
+mine:
+
+@example
+<x6u3u47icf.fsf@@eyesore.no>
+<x6sp9o7ibw.fsf@@eyesore.no>
+@end example
+
+So ``my'' ident on this machine is @samp{x6}. This can be
+exploited---the following rule will raise the score on all followups to
+myself:
+
+@lisp
+("references"
+ ("<x6[0-9a-z]+\\.fsf\\(_-_\\)?@@.*eyesore.no>"
+ 1000 nil r))
+@end lisp
+
+Whether it's the first two or first three characters that are ``yours''
+is system-dependent.
+
+
+@node Scoring Tips
+@section Scoring Tips
+@cindex scoring tips
+
+@table @dfn
+
+@item Crossposts
+@cindex crossposts
+@cindex scoring crossposts
+If you want to lower the score of crossposts, the line to match on is
+the @code{Xref} header.
+@lisp
+("xref" (" talk.politics.misc:" -1000))
+@end lisp
+
+@item Multiple crossposts
+If you want to lower the score of articles that have been crossposted to
+more than, say, 3 groups:
+@lisp
+("xref" ("[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+" -1000 nil r))
+@end lisp
+
+@item Matching on the body
+This is generally not a very good idea---it takes a very long time.
+Gnus actually has to fetch each individual article from the server. But
+you might want to anyway, I guess. Even though there are three match
+keys (@code{Head}, @code{Body} and @code{All}), you should choose one
+and stick with it in each score file. If you use any two, each article
+will be fetched @emph{twice}. If you want to match a bit on the
+@code{Head} and a bit on the @code{Body}, just use @code{All} for all
+the matches.
+
+@item Marking as read
+You will probably want to mark articles that has a score below a certain
+number as read. This is most easily achieved by putting the following
+in your @file{all.SCORE} file:
+@lisp
+((mark -100))
+@end lisp
+You may also consider doing something similar with @code{expunge}.
+
+@item Negated character classes
+If you say stuff like @code{[^abcd]*}, you may get unexpected results.
+That will match newlines, which might lead to, well, The Unknown. Say
+@code{[^abcd\n]*} instead.
+@end table
+
+
+@node Reverse Scoring
+@section Reverse Scoring
+@cindex reverse scoring
+
+If you want to keep just articles that have @samp{Sex with Emacs} in the
+subject header, and expunge all other articles, you could put something
+like this in your score file:
+
+@lisp
+(("subject"
+ ("Sex with Emacs" 2))
+ (mark 1)
+ (expunge 1))
+@end lisp
+
+So, you raise all articles that match @samp{Sex with Emacs} and mark the
+rest as read, and expunge them to boot.
+
+
+@node Global Score Files
+@section Global Score Files
+@cindex global score files
+
+Sure, other newsreaders have ``global kill files''. These are usually
+nothing more than a single kill file that applies to all groups, stored
+in the user's home directory. Bah! Puny, weak newsreaders!
+
+What I'm talking about here are Global Score Files. Score files from
+all over the world, from users everywhere, uniting all nations in one
+big, happy score file union! Ange-score! New and untested!
+
+@vindex gnus-global-score-files
+All you have to do to use other people's score files is to set the
+@code{gnus-global-score-files} variable. One entry for each score file,
+or each score file directory. Gnus will decide by itself what score
+files are applicable to which group.
+
+Say you want to use the score file
+@file{/ftp@@ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE} and
+all score files in the @file{/ftp@@ftp.some-where:/pub/score} directory:
+
+@lisp
+(setq gnus-global-score-files
+ '("/ftp@@ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE"
+ "/ftp@@ftp.some-where:/pub/score/"))
+@end lisp
+
+@findex gnus-score-search-global-directories
+Simple, eh? Directory names must end with a @samp{/}. These
+directories are typically scanned only once during each Gnus session.
+If you feel the need to manually re-scan the remote directories, you can
+use the @code{gnus-score-search-global-directories} command.
+
+Note that, at present, using this option will slow down group entry
+somewhat. (That is---a lot.)
+
+If you want to start maintaining score files for other people to use,
+just put your score file up for anonymous ftp and announce it to the
+world. Become a retro-moderator! Participate in the retro-moderator
+wars sure to ensue, where retro-moderators battle it out for the
+sympathy of the people, luring them to use their score files on false
+premises! Yay! The net is saved!
+
+Here are some tips for the would-be retro-moderator, off the top of my
+head:
+
+@itemize @bullet
+
+@item
+Articles heavily crossposted are probably junk.
+@item
+To lower a single inappropriate article, lower by @code{Message-ID}.
+@item
+Particularly brilliant authors can be raised on a permanent basis.
+@item
+Authors that repeatedly post off-charter for the group can safely be
+lowered out of existence.
+@item
+Set the @code{mark} and @code{expunge} atoms to obliterate the nastiest
+articles completely.
+
+@item
+Use expiring score entries to keep the size of the file down. You
+should probably have a long expiry period, though, as some sites keep
+old articles for a long time.
+@end itemize
+
+... I wonder whether other newsreaders will support global score files
+in the future. @emph{Snicker}. Yup, any day now, newsreaders like Blue
+Wave, xrn and 1stReader are bound to implement scoring. Should we start
+holding our breath yet?
+
+
+@node Kill Files
+@section Kill Files
+@cindex kill files
+
+Gnus still supports those pesky old kill files. In fact, the kill file
+entries can now be expiring, which is something I wrote before Daniel
+Quinlan thought of doing score files, so I've left the code in there.
+
+In short, kill processing is a lot slower (and I do mean @emph{a lot})
+than score processing, so it might be a good idea to rewrite your kill
+files into score files.
+
+Anyway, a kill file is a normal @code{emacs-lisp} file. You can put any
+forms into this file, which means that you can use kill files as some
+sort of primitive hook function to be run on group entry, even though
+that isn't a very good idea.
+
+Normal kill files look like this:
+
+@lisp
+(gnus-kill "From" "Lars Ingebrigtsen")
+(gnus-kill "Subject" "ding")
+(gnus-expunge "X")
+@end lisp
+
+This will mark every article written by me as read, and remove the
+marked articles from the summary buffer. Very useful, you'll agree.
+
+Other programs use a totally different kill file syntax. If Gnus
+encounters what looks like a @code{rn} kill file, it will take a stab at
+interpreting it.
+
+Two summary functions for editing a GNUS kill file:
+
+@table @kbd
+
+@item M-k
+@kindex M-k (Summary)
+@findex gnus-summary-edit-local-kill
+Edit this group's kill file (@code{gnus-summary-edit-local-kill}).
+
+@item M-K
+@kindex M-K (Summary)
+@findex gnus-summary-edit-global-kill
+Edit the general kill file (@code{gnus-summary-edit-global-kill}).
+@end table
+
+Two group mode functions for editing the kill files:
+
+@table @kbd
+
+@item M-k
+@kindex M-k (Group)
+@findex gnus-group-edit-local-kill
+Edit this group's kill file (@code{gnus-group-edit-local-kill}).
+
+@item M-K
+@kindex M-K (Group)
+@findex gnus-group-edit-global-kill
+Edit the general kill file (@code{gnus-group-edit-global-kill}).
+@end table
+
+Kill file variables:
+
+@table @code
+@item gnus-kill-file-name
+@vindex gnus-kill-file-name
+A kill file for the group @samp{soc.motss} is normally called
+@file{soc.motss.KILL}. The suffix appended to the group name to get
+this file name is detailed by the @code{gnus-kill-file-name} variable.
+The ``global'' kill file (not in the score file sense of ``global'', of
+course) is just called @file{KILL}.
+
+@vindex gnus-kill-save-kill-file
+@item gnus-kill-save-kill-file
+If this variable is non-@code{nil}, Gnus will save the
+kill file after processing, which is necessary if you use expiring
+kills.
+
+@item gnus-apply-kill-hook
+@vindex gnus-apply-kill-hook
+@findex gnus-apply-kill-file-unless-scored
+@findex gnus-apply-kill-file
+A hook called to apply kill files to a group. It is
+@code{(gnus-apply-kill-file)} by default. If you want to ignore the
+kill file if you have a score file for the same group, you can set this
+hook to @code{(gnus-apply-kill-file-unless-scored)}. If you don't want
+kill files to be processed, you should set this variable to @code{nil}.
+
+@item gnus-kill-file-mode-hook
+@vindex gnus-kill-file-mode-hook
+A hook called in kill-file mode buffers.
+
+@end table
+
+
+@node Converting Kill Files
+@section Converting Kill Files
+@cindex kill files
+@cindex converting kill files
+
+If you have loads of old kill files, you may want to convert them into
+score files. If they are ``regular'', you can use
+the @file{gnus-kill-to-score.el} package; if not, you'll have to do it
+by hand.
+
+The kill to score conversion package isn't included in Gnus by default.
+You can fetch it from
+@file{http://www.ifi.uio.no/~larsi/ding-other/gnus-kill-to-score}.
+
+If your old kill files are very complex---if they contain more
+non-@code{gnus-kill} forms than not, you'll have to convert them by
+hand. Or just let them be as they are. Gnus will still use them as
+before.
+
+
+@node GroupLens
+@section GroupLens
+@cindex GroupLens
+
+GroupLens is a collaborative filtering system that helps you work
+together with other people to find the quality news articles out of the
+huge volume of news articles generated every day.
+
+To accomplish this the GroupLens system combines your opinions about
+articles you have already read with the opinions of others who have done
+likewise and gives you a personalized prediction for each unread news
+article. Think of GroupLens as a matchmaker. GroupLens watches how you
+rate articles, and finds other people that rate articles the same way.
+Once it has found some people you agree with it tells you, in the form
+of a prediction, what they thought of the article. You can use this
+prediction to help you decide whether or not you want to read the
+article.
+
+@menu
+* Using GroupLens:: How to make Gnus use GroupLens.
+* Rating Articles:: Letting GroupLens know how you rate articles.
+* Displaying Predictions:: Displaying predictions given by GroupLens.
+* GroupLens Variables:: Customizing GroupLens.
+@end menu
+
+
+@node Using GroupLens
+@subsection Using GroupLens
+
+To use GroupLens you must register a pseudonym with your local Better
+Bit Bureau (BBB).
+@samp{http://www.cs.umn.edu/Research/GroupLens/bbb.html} is the only
+better bit in town at the moment.
+
+Once you have registered you'll need to set a couple of variables.
+
+@table @code
+
+@item gnus-use-grouplens
+@vindex gnus-use-grouplens
+Setting this variable to a non-@code{nil} value will make Gnus hook into
+all the relevant GroupLens functions.
+
+@item grouplens-pseudonym
+@vindex grouplens-pseudonym
+This variable should be set to the pseudonym you got when registering
+with the Better Bit Bureau.
+
+@item grouplens-newsgroups
+@vindex grouplens-newsgroups
+A list of groups that you want to get GroupLens predictions for.
+
+@end table
+
+That's the minimum of what you need to get up and running with GroupLens.
+Once you've registered, GroupLens will start giving you scores for
+articles based on the average of what other people think. But, to get
+the real benefit of GroupLens you need to start rating articles
+yourself. Then the scores GroupLens gives you will be personalized for
+you, based on how the people you usually agree with have already rated.
+
+
+@node Rating Articles
+@subsection Rating Articles
+
+In GroupLens, an article is rated on a scale from 1 to 5, inclusive.
+Where 1 means something like this article is a waste of bandwidth and 5
+means that the article was really good. The basic question to ask
+yourself is, "on a scale from 1 to 5 would I like to see more articles
+like this one?"
+
+There are four ways to enter a rating for an article in GroupLens.
+
+@table @kbd
+
+@item r
+@kindex r (GroupLens)
+@findex bbb-summary-rate-article
+This function will prompt you for a rating on a scale of one to five.
+
+@item k
+@kindex k (GroupLens)
+@findex grouplens-score-thread
+This function will prompt you for a rating, and rate all the articles in
+the thread. This is really useful for some of those long running giant
+threads in rec.humor.
+
+@end table
+
+The next two commands, @kbd{n} and @kbd{,} take a numerical prefix to be
+the score of the article you're reading.
+
+@table @kbd
+
+@item 1-5 n
+@kindex n (GroupLens)
+@findex grouplens-next-unread-article
+Rate the article and go to the next unread article.
+
+@item 1-5 ,
+@kindex , (GroupLens)
+@findex grouplens-best-unread-article
+Rate the article and go to the next unread article with the highest score.
+
+@end table
+
+If you want to give the current article a score of 4 and then go to the
+next article, just type @kbd{4 n}.
+
+
+@node Displaying Predictions
+@subsection Displaying Predictions
+
+GroupLens makes a prediction for you about how much you will like a
+news article. The predictions from GroupLens are on a scale from 1 to
+5, where 1 is the worst and 5 is the best. You can use the predictions
+from GroupLens in one of three ways controlled by the variable
+@code{gnus-grouplens-override-scoring}.
+
+@vindex gnus-grouplens-override-scoring
+There are three ways to display predictions in grouplens. You may
+choose to have the GroupLens scores contribute to, or override the
+regular gnus scoring mechanism. override is the default; however, some
+people prefer to see the Gnus scores plus the grouplens scores. To get
+the separate scoring behavior you need to set
+@code{gnus-grouplens-override-scoring} to @code{'separate}. To have the
+GroupLens predictions combined with the grouplens scores set it to
+@code{'override} and to combine the scores set
+@code{gnus-grouplens-override-scoring} to @code{'combine}. When you use
+the combine option you will also want to set the values for
+@code{grouplens-prediction-offset} and
+@code{grouplens-score-scale-factor}.
+
+@vindex grouplens-prediction-display
+In either case, GroupLens gives you a few choices for how you would like
+to see your predictions displayed. The display of predictions is
+controlled by the @code{grouplens-prediction-display} variable.
+
+The following are valid values for that variable.
+
+@table @code
+@item prediction-spot
+The higher the prediction, the further to the right an @samp{*} is
+displayed.
+
+@item confidence-interval
+A numeric confidence interval.
+
+@item prediction-bar
+The higher the prediction, the longer the bar.
+
+@item confidence-bar
+Numerical confidence.
+
+@item confidence-spot
+The spot gets bigger with more confidence.
+
+@item prediction-num
+Plain-old numeric value.
+
+@item confidence-plus-minus
+Prediction +/- confidence.
+
+@end table
+
+
+@node GroupLens Variables
+@subsection GroupLens Variables
+
+@table @code
+
+@item gnus-summary-grouplens-line-format
+The summary line format used in GroupLens-enhanced summary buffers. It
+accepts the same specs as the normal summary line format (@pxref{Summary
+Buffer Lines}). The default is @samp{%U%R%z%l%I%(%[%4L: %-20,20n%]%)
+%s\n}.
+
+@item grouplens-bbb-host
+Host running the bbbd server. @samp{grouplens.cs.umn.edu} is the
+default.
+
+@item grouplens-bbb-port
+Port of the host running the bbbd server. The default is 9000.
+
+@item grouplens-score-offset
+Offset the prediction by this value. In other words, subtract the
+prediction value by this number to arrive at the effective score. The
+default is 0.
+
+@item grouplens-score-scale-factor
+This variable allows the user to magnify the effect of GroupLens scores.
+The scale factor is applied after the offset. The default is 1.
+
+@end table
+
+
+@node Advanced Scoring
+@section Advanced Scoring
+
+Scoring on Subjects and From headers is nice enough, but what if you're
+really interested in what a person has to say only when she's talking
+about a particular subject? Or what if you really don't want to
+read what person A has to say when she's following up to person B, but
+want to read what she says when she's following up to person C?
+
+By using advanced scoring rules you may create arbitrarily complex
+scoring patterns.
+
+@menu
+* Advanced Scoring Syntax:: A definition.
+* Advanced Scoring Examples:: What they look like.
+* Advanced Scoring Tips:: Getting the most out of it.
+@end menu
+
+
+@node Advanced Scoring Syntax
+@subsection Advanced Scoring Syntax
+
+Ordinary scoring rules have a string as the first element in the rule.
+Advanced scoring rules have a list as the first element. The second
+element is the score to be applied if the first element evaluated to a
+non-@code{nil} value.
+
+These lists may consist of three logical operators, one redirection
+operator, and various match operators.
+
+Logical operators:
+
+@table @code
+@item &
+@itemx and
+This logical operator will evaluate each of its arguments until it finds
+one that evaluates to @code{false}, and then it'll stop. If all arguments
+evaluate to @code{true} values, then this operator will return
+@code{true}.
+
+@item |
+@itemx or
+This logical operator will evaluate each of its arguments until it finds
+one that evaluates to @code{true}. If no arguments are @code{true},
+then this operator will return @code{false}.
+
+@item !
+@itemx not
+@itemx ¬
+This logical operator only takes a single argument. It returns the
+logical negation of the value of its argument.
+
+@end table
+
+There is an @dfn{indirection operator} that will make its arguments
+apply to the ancestors of the current article being scored. For
+instance, @code{1-} will make score rules apply to the parent of the
+current article. @code{2-} will make score rules apply to the
+grandparent of the current article. Alternatively, you can write
+@code{^^}, where the number of @code{^}s (carets) says how far back into
+the ancestry you want to go.
+
+Finally, we have the match operators. These are the ones that do the
+real work. Match operators are header name strings followed by a match
+and a match type. A typical match operator looks like @samp{("from"
+"Lars Ingebrigtsen" s)}. The header names are the same as when using
+simple scoring, and the match types are also the same.
+
+
+@node Advanced Scoring Examples
+@subsection Advanced Scoring Examples
+
+Let's say you want to increase the score of articles written by Lars
+when he's talking about Gnus:
+
+@example
+((&
+ ("from" "Lars Ingebrigtsen")
+ ("subject" "Gnus"))
+ 1000)
+@end example
+
+Quite simple, huh?
+
+When he writes long articles, he sometimes has something nice to say:
+
+@example
+((&
+ ("from" "Lars Ingebrigtsen")
+ (|
+ ("subject" "Gnus")
+ ("lines" 100 >)))
+ 1000)
+@end example
+
+However, when he responds to things written by Reig Eigil Logge, you
+really don't want to read what he's written:
+
+@example
+((&
+ ("from" "Lars Ingebrigtsen")
+ (1- ("from" "Reig Eigir Logge")))
+ -100000)
+@end example
+
+Everybody that follows up Redmondo when he writes about disappearing
+socks should have their scores raised, but only when they talk about
+white socks. However, when Lars talks about socks, it's usually not
+very interesting:
+
+@example
+((&
+ (1-
+ (&
+ ("from" "redmondo@@.*no" r)
+ ("body" "disappearing.*socks" t)))
+ (! ("from" "Lars Ingebrigtsen"))
+ ("body" "white.*socks"))
+ 1000)
+@end example
+
+The possibilities are endless.
+
+
+@node Advanced Scoring Tips
+@subsection Advanced Scoring Tips
+
+The @code{&} and @code{|} logical operators do short-circuit logic.
+That is, they stop processing their arguments when it's clear what the
+result of the operation will be. For instance, if one of the arguments
+of an @code{&} evaluates to @code{false}, there's no point in evaluating
+the rest of the arguments. This means that you should put slow matches
+(@samp{body}, @samp{header}) last and quick matches (@samp{from},
+@samp{subject}) first.
+
+The indirection arguments (@code{1-} and so on) will make their
+arguments work on previous generations of the thread. If you say
+something like:
+
+@example
+...
+(1-
+ (1-
+ ("from" "lars")))
+...
+@end example
+
+Then that means "score on the from header of the grandparent of the
+current article". An indirection is quite fast, but it's better to say:
+
+@example
+(1-
+ (&
+ ("from" "Lars")
+ ("subject" "Gnus")))
+@end example
+
+than it is to say:
+
+@example
+(&
+ (1- ("from" "Lars"))
+ (1- ("subject" "Gnus")))
+@end example
+
+
+@node Score Decays
+@section Score Decays
+@cindex score decays
+@cindex decays
+
+You may find that your scores have a tendency to grow without
+bounds, especially if you're using adaptive scoring. If scores get too
+big, they lose all meaning---they simply max out and it's difficult to
+use them in any sensible way.
+
+@vindex gnus-decay-scores
+@findex gnus-decay-score
+@vindex gnus-score-decay-function
+Gnus provides a mechanism for decaying scores to help with this problem.
+When score files are loaded and @code{gnus-decay-scores} is
+non-@code{nil}, Gnus will run the score files through the decaying
+mechanism thereby lowering the scores of all non-permanent score rules.
+The decay itself if performed by the @code{gnus-score-decay-function}
+function, which is @code{gnus-decay-score} by default. Here's the
+definition of that function:
+
+@lisp
+(defun gnus-decay-score (score)
+ "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'."
+ (floor
+ (- score
+ (* (if (< score 0) 1 -1)
+ (min (abs score)
+ (max gnus-score-decay-constant
+ (* (abs score)
+ gnus-score-decay-scale)))))))
+@end lisp
+
+@vindex gnus-score-decay-scale
+@vindex gnus-score-decay-constant
+@code{gnus-score-decay-constant} is 3 by default and
+@code{gnus-score-decay-scale} is 0.05. This should cause the following:
+
+@enumerate
+@item
+Scores between -3 and 3 will be set to 0 when this function is called.
+
+@item
+Scores with magnitudes between 3 and 60 will be shrunk by 3.
+
+@item
+Scores with magnitudes greater than 60 will be shrunk by 5% of the
+score.
+@end enumerate
+
+If you don't like this decay function, write your own. It is called
+with the score to be decayed as its only parameter, and it should return
+the new score, which should be an integer.
+
+Gnus will try to decay scores once a day. If you haven't run Gnus for
+four days, Gnus will decay the scores four times, for instance.
+
+
+@node Various
+@chapter Various
+
+@menu
+* Process/Prefix:: A convention used by many treatment commands.
+* Interactive:: Making Gnus ask you many questions.
+* Symbolic Prefixes:: How to supply some Gnus functions with options.
+* Formatting Variables:: You can specify what buffers should look like.
+* Windows Configuration:: Configuring the Gnus buffer windows.
+* Compilation:: How to speed Gnus up.
+* Mode Lines:: Displaying information in the mode lines.
+* Highlighting and Menus:: Making buffers look all nice and cozy.
+* Buttons:: Get tendonitis in ten easy steps!
+* Daemons:: Gnus can do things behind your back.
+* NoCeM:: How to avoid spam and other fatty foods.
+* Undo:: Some actions can be undone.
+* Moderation:: What to do if you're a moderator.
+* XEmacs Enhancements:: There are more pictures and stuff under XEmacs.
+* Fuzzy Matching:: What's the big fuzz?
+* Thwarting Email Spam:: A how-to on avoiding unsolited commercial email.
+* Various Various:: Things that are really various.
+@end menu
+
+
+@node Process/Prefix
+@section Process/Prefix
+@cindex process/prefix convention
+
+Many functions, among them functions for moving, decoding and saving
+articles, use what is known as the @dfn{Process/Prefix convention}.
+
+This is a method for figuring out what articles the user wants the
+command to be performed on.
+
+It goes like this:
+
+If the numeric prefix is N, perform the operation on the next N
+articles, starting with the current one. If the numeric prefix is
+negative, perform the operation on the previous N articles, starting
+with the current one.
+
+@vindex transient-mark-mode
+If @code{transient-mark-mode} in non-@code{nil} and the region is
+active, all articles in the region will be worked upon.
+
+If there is no numeric prefix, but some articles are marked with the
+process mark, perform the operation on the articles marked with
+the process mark.
+
+If there is neither a numeric prefix nor any articles marked with the
+process mark, just perform the operation on the current article.
+
+Quite simple, really, but it needs to be made clear so that surprises
+are avoided.
+
+Commands that react to the process mark will push the current list of
+process marked articles onto a stack and will then clear all process
+marked articles. You can restore the previous configuration with the
+@kbd{M P y} command (@pxref{Setting Process Marks}).
+
+@vindex gnus-summary-goto-unread
+One thing that seems to shock & horrify lots of people is that, for
+instance, @kbd{3 d} does exactly the same as @kbd{d} @kbd{d} @kbd{d}.
+Since each @kbd{d} (which marks the current article as read) by default
+goes to the next unread article after marking, this means that @kbd{3 d}
+will mark the next three unread articles as read, no matter what the
+summary buffer looks like. Set @code{gnus-summary-goto-unread} to
+@code{nil} for a more straightforward action.
+
+
+@node Interactive
+@section Interactive
+@cindex interaction
+
+@table @code
+
+@item gnus-novice-user
+@vindex gnus-novice-user
+If this variable is non-@code{nil}, you are either a newcomer to the
+World of Usenet, or you are very cautious, which is a nice thing to be,
+really. You will be given questions of the type ``Are you sure you want
+to do this?'' before doing anything dangerous. This is @code{t} by
+default.
+
+@item gnus-expert-user
+@vindex gnus-expert-user
+If this variable is non-@code{nil}, you will never ever be asked any
+questions by Gnus. It will simply assume you know what you're doing, no
+matter how strange.
+
+@item gnus-interactive-catchup
+@vindex gnus-interactive-catchup
+Require confirmation before catching up a group if non-@code{nil}. It
+is @code{t} by default.
+
+@item gnus-interactive-exit
+@vindex gnus-interactive-exit
+Require confirmation before exiting Gnus. This variable is @code{t} by
+default.
+@end table
+
+
+@node Symbolic Prefixes
+@section Symbolic Prefixes
+@cindex symbolic prefixes
+
+Quite a lot of Emacs commands react to the (numeric) prefix. For
+instance, @kbd{C-u 4 C-f} moves point four charaters forward, and
+@kbd{C-u 9 0 0 I s s p} adds a permanent @code{Subject} substring score
+rule of 900 to the current article.
+
+This is all nice and well, but what if you want to give a command some
+additional information? Well, what most commands do is interpret the
+``raw'' prefix in some special way. @kbd{C-u 0 C-x C-s} means that one
+doesn't want a backup file to be created when saving the current buffer,
+for instance. But what if you want to save without making a backup
+file, and you want Emacs to flash lights and play a nice tune at the
+same time? You can't, and you're probably perfectly happy that way.
+
+@kindex M-i (Summary)
+@findex gnus-symbolic-argument
+I'm not, so I've added a second prefix---the @dfn{symbolic prefix}. The
+prefix key is @kbd{M-i} (@code{gnus-symbolic-argument}), and the next
+character typed in is the value. You can stack as many @kbd{M-i}
+prefixes as you want. @kbd{M-i a M-C-u} means ``feed the @kbd{M-C-u}
+command the symbolic prefix @code{a}''. @kbd{M-i a M-i b M-C-u} means
+``feed the @kbd{M-C-u} command the symbolic prefixes @code{a} and
+@code{b}''. You get the drift.
+
+Typing in symbolic prefixes to commands that don't accept them doesn't
+hurt, but it doesn't do any good either. Currently not many Gnus
+functions make use of the symbolic prefix.
+
+If you're interested in how Gnus implements this, @pxref{Extended
+Interactive}.
+
+
+@node Formatting Variables
+@section Formatting Variables
+@cindex formatting variables
+
+Throughout this manual you've probably noticed lots of variables called things like @code{gnus-group-line-format} and
+@code{gnus-summary-mode-line-format}. These control how Gnus is to
+output lines in the various buffers. There's quite a lot of them.
+Fortunately, they all use the same syntax, so there's not that much to
+be annoyed by.
+
+Here's an example format spec (from the group buffer): @samp{%M%S%5y:
+%(%g%)\n}. We see that it is indeed extremely ugly, and that there are
+lots of percentages everywhere.
+
+@menu
+* Formatting Basics:: A formatting variable is basically a format string.
+* Advanced Formatting:: Modifying output in various ways.
+* User-Defined Specs:: Having Gnus call your own functions.
+* Formatting Fonts:: Making the formatting look colorful and nice.
+@end menu
+
+Currently Gnus uses the following formatting variables:
+@code{gnus-group-line-format}, @code{gnus-summary-line-format},
+@code{gnus-server-line-format}, @code{gnus-topic-line-format},
+@code{gnus-group-mode-line-format},
+@code{gnus-summary-mode-line-format},
+@code{gnus-article-mode-line-format},
+@code{gnus-server-mode-line-format}, and
+@code{gnus-summary-pick-line-format}.
+
+All these format variables can also be arbitrary elisp forms. In that
+case, they will be @code{eval}ed to insert the required lines.
+
+@kindex M-x gnus-update-format
+@findex gnus-update-format
+Gnus includes a command to help you while creating your own format
+specs. @kbd{M-x gnus-update-format} will @code{eval} the current form,
+update the spec in question and pop you to a buffer where you can
+examine the resulting lisp code to be run to generate the line.
+
+
+
+@node Formatting Basics
+@subsection Formatting Basics
+
+Each @samp{%} element will be replaced by some string or other when the
+buffer in question is generated. @samp{%5y} means ``insert the @samp{y}
+spec, and pad with spaces to get a 5-character field''.
+
+As with normal C and Emacs Lisp formatting strings, the numerical
+modifier between the @samp{%} and the formatting type character will
+@dfn{pad} the output so that it is always at least that long.
+@samp{%5y} will make the field always (at least) five characters wide by
+padding with spaces to the left. If you say @samp{%-5y}, it will pad to
+the right instead.
+
+You may also wish to limit the length of the field to protect against
+particularly wide values. For that you can say @samp{%4,6y}, which
+means that the field will never be more than 6 characters wide and never
+less than 4 characters wide.
+
+
+@node Advanced Formatting
+@subsection Advanced Formatting
+
+It is frequently useful to post-process the fields in some way.
+Padding, limiting, cutting off parts and suppressing certain values can
+be achieved by using @dfn{tilde modifiers}. A typical tilde spec might
+look like @samp{%~(cut 3)~(ignore "0")y}.
+
+These are the valid modifiers:
+
+@table @code
+@item pad
+@itemx pad-left
+Pad the field to the left with spaces until it reaches the required
+length.
+
+@item pad-right
+Pad the field to the right with spaces until it reaches the required
+length.
+
+@item max
+@itemx max-left
+Cut off characters from the left until it reaches the specified length.
+
+@item max-right
+Cut off characters from the right until it reaches the specified
+length.
+
+@item cut
+@itemx cut-left
+Cut off the specified number of characters from the left.
+
+@item cut-right
+Cut off the specified number of characters from the right.
+
+@item ignore
+Return an empty string if the field is equal to the specified value.
+
+@item form
+Use the specified form as the field value when the @samp{@@} spec is
+used.
+@end table
+
+Let's take an example. The @samp{%o} spec in the summary mode lines
+will return a date in compact ISO8601 format---@samp{19960809T230410}.
+This is quite a mouthful, so we want to shave off the century number and
+the time, leaving us with a six-character date. That would be
+@samp{%~(cut-left 2)~(max-right 6)~(pad 6)o}. (Cutting is done before
+maxing, and we need the padding to ensure that the date is never less
+than 6 characters to make it look nice in columns.)
+
+Ignoring is done first; then cutting; then maxing; and then as the very
+last operation, padding.
+
+If you use lots of these advanced thingies, you'll find that Gnus gets
+quite slow. This can be helped enormously by running @kbd{M-x
+gnus-compile} when you are satisfied with the look of your lines.
+@xref{Compilation}.
+
+
+@node User-Defined Specs
+@subsection User-Defined Specs
+
+All the specs allow for inserting user defined specifiers---@samp{u}.
+The next character in the format string should be a letter. Gnus
+will call the function @code{gnus-user-format-function-}@samp{X}, where
+@samp{X} is the letter following @samp{%u}. The function will be passed
+a single parameter---what the parameter means depends on what buffer
+it's being called from. The function should return a string, which will
+be inserted into the buffer just like information from any other
+specifier. This function may also be called with dummy values, so it
+should protect against that.
+
+You can also use tilde modifiers (@pxref{Advanced Formatting} to achieve
+much the same without defining new functions. Here's an example:
+@samp{%~(form (count-lines (point-min) (point)))@@}. The form
+given here will be evaluated to yield the current line number, and then
+inserted.
+
+
+@node Formatting Fonts
+@subsection Formatting Fonts
+
+There are specs for highlighting, and these are shared by all the format
+variables. Text inside the @samp{%(} and @samp{%)} specifiers will get
+the special @code{mouse-face} property set, which means that it will be
+highlighted (with @code{gnus-mouse-face}) when you put the mouse pointer
+over it.
+
+Text inside the @samp{%[} and @samp{%]} specifiers will have their
+normal faces set using @code{gnus-face-0}, which is @code{bold} by
+default. If you say @samp{%1[}, you'll get @code{gnus-face-1} instead,
+and so on. Create as many faces as you wish. The same goes for the
+@code{mouse-face} specs---you can say @samp{%3(hello%)} to have
+@samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}.
+
+Here's an alternative recipe for the group buffer:
+
+@lisp
+;; Create three face types.
+(setq gnus-face-1 'bold)
+(setq gnus-face-3 'italic)
+
+;; We want the article count to be in
+;; a bold and green face. So we create
+;; a new face called `my-green-bold'.
+(copy-face 'bold 'my-green-bold)
+;; Set the color.
+(set-face-foreground 'my-green-bold "ForestGreen")
+(setq gnus-face-2 'my-green-bold)
+
+;; Set the new & fancy format.
+(setq gnus-group-line-format
+ "%M%S%3@{%5y%@}%2[:%] %(%1@{%g%@}%)\n")
+@end lisp
+
+I'm sure you'll be able to use this scheme to create totally unreadable
+and extremely vulgar displays. Have fun!
+
+Note that the @samp{%(} specs (and friends) do not make any sense on the
+mode-line variables.
+
+
+@node Windows Configuration
+@section Windows Configuration
+@cindex windows configuration
+
+No, there's nothing here about X, so be quiet.
+
+@vindex gnus-use-full-window
+If @code{gnus-use-full-window} non-@code{nil}, Gnus will delete all
+other windows and occupy the entire Emacs screen by itself. It is
+@code{t} by default.
+
+@vindex gnus-buffer-configuration
+@code{gnus-buffer-configuration} describes how much space each Gnus
+buffer should be given. Here's an excerpt of this variable:
+
+@lisp
+((group (vertical 1.0 (group 1.0 point)
+ (if gnus-carpal (group-carpal 4))))
+ (article (vertical 1.0 (summary 0.25 point)
+ (article 1.0))))
+@end lisp
+
+This is an alist. The @dfn{key} is a symbol that names some action or
+other. For instance, when displaying the group buffer, the window
+configuration function will use @code{group} as the key. A full list of
+possible names is listed below.
+
+The @dfn{value} (i.e., the @dfn{split}) says how much space each buffer
+should occupy. To take the @code{article} split as an example -
+
+@lisp
+(article (vertical 1.0 (summary 0.25 point)
+ (article 1.0)))
+@end lisp
+
+This @dfn{split} says that the summary buffer should occupy 25% of upper
+half of the screen, and that it is placed over the article buffer. As
+you may have noticed, 100% + 25% is actually 125% (yup, I saw y'all
+reaching for that calculator there). However, the special number
+@code{1.0} is used to signal that this buffer should soak up all the
+rest of the space available after the rest of the buffers have taken
+whatever they need. There should be only one buffer with the @code{1.0}
+size spec per split.
+
+Point will be put in the buffer that has the optional third element
+@code{point}.
+
+Here's a more complicated example:
+
+@lisp
+(article (vertical 1.0 (group 4)
+ (summary 0.25 point)
+ (if gnus-carpal (summary-carpal 4))
+ (article 1.0)))
+@end lisp
+
+If the size spec is an integer instead of a floating point number,
+then that number will be used to say how many lines a buffer should
+occupy, not a percentage.
+
+If the @dfn{split} looks like something that can be @code{eval}ed (to be
+precise---if the @code{car} of the split is a function or a subr), this
+split will be @code{eval}ed. If the result is non-@code{nil}, it will
+be used as a split. This means that there will be three buffers if
+@code{gnus-carpal} is @code{nil}, and four buffers if @code{gnus-carpal}
+is non-@code{nil}.
+
+Not complicated enough for you? Well, try this on for size:
+
+@lisp
+(article (horizontal 1.0
+ (vertical 0.5
+ (group 1.0)
+ (gnus-carpal 4))
+ (vertical 1.0
+ (summary 0.25 point)
+ (summary-carpal 4)
+ (article 1.0))))
+@end lisp
+
+Whoops. Two buffers with the mystery 100% tag. And what's that
+@code{horizontal} thingie?
+
+If the first element in one of the split is @code{horizontal}, Gnus will
+split the window horizontally, giving you two windows side-by-side.
+Inside each of these strips you may carry on all you like in the normal
+fashion. The number following @code{horizontal} says what percentage of
+the screen is to be given to this strip.
+
+For each split, there @emph{must} be one element that has the 100% tag.
+The splitting is never accurate, and this buffer will eat any leftover
+lines from the splits.
+
+To be slightly more formal, here's a definition of what a valid split
+may look like:
+
+@example
+split = frame | horizontal | vertical | buffer | form
+frame = "(frame " size *split ")"
+horizontal = "(horizontal " size *split ")"
+vertical = "(vertical " size *split ")"
+buffer = "(" buffer-name " " size *[ "point" ] ")"
+size = number | frame-params
+buffer-name = group | article | summary ...
+@end example
+
+The limitations are that the @code{frame} split can only appear as the
+top-level split. @var{form} should be an Emacs Lisp form that should
+return a valid split. We see that each split is fully recursive, and
+may contain any number of @code{vertical} and @code{horizontal} splits.
+
+@vindex gnus-window-min-width
+@vindex gnus-window-min-height
+@cindex window height
+@cindex window width
+Finding the right sizes can be a bit complicated. No window may be less
+than @code{gnus-window-min-height} (default 1) characters high, and all
+windows must be at least @code{gnus-window-min-width} (default 1)
+characters wide. Gnus will try to enforce this before applying the
+splits. If you want to use the normal Emacs window width/height limit,
+you can just set these two variables to @code{nil}.
+
+If you're not familiar with Emacs terminology, @code{horizontal} and
+@code{vertical} splits may work the opposite way of what you'd expect.
+Windows inside a @code{horizontal} split are shown side-by-side, and
+windows within a @code{vertical} split are shown above each other.
+
+@findex gnus-configure-frame
+If you want to experiment with window placement, a good tip is to call
+@code{gnus-configure-frame} directly with a split. This is the function
+that does all the real work when splitting buffers. Below is a pretty
+nonsensical configuration with 5 windows; two for the group buffer and
+three for the article buffer. (I said it was nonsensical.) If you
+@code{eval} the statement below, you can get an idea of how that would
+look straight away, without going through the normal Gnus channels.
+Play with it until you're satisfied, and then use
+@code{gnus-add-configuration} to add your new creation to the buffer
+configuration list.
+
+@lisp
+(gnus-configure-frame
+ '(horizontal 1.0
+ (vertical 10
+ (group 1.0)
+ (article 0.3 point))
+ (vertical 1.0
+ (article 1.0)
+ (horizontal 4
+ (group 1.0)
+ (article 10)))))
+@end lisp
+
+You might want to have several frames as well. No prob---just use the
+@code{frame} split:
+
+@lisp
+(gnus-configure-frame
+ '(frame 1.0
+ (vertical 1.0
+ (summary 0.25 point)
+ (article 1.0))
+ (vertical ((height . 5) (width . 15)
+ (user-position . t)
+ (left . -1) (top . 1))
+ (picon 1.0))))
+
+@end lisp
+
+This split will result in the familiar summary/article window
+configuration in the first (or ``main'') frame, while a small additional
+frame will be created where picons will be shown. As you can see,
+instead of the normal @code{1.0} top-level spec, each additional split
+should have a frame parameter alist as the size spec.
+@xref{Frame Parameters, , Frame Parameters, elisp, The GNU Emacs Lisp
+Reference Manual}. Under XEmacs, a frame property list will be
+accepted, too---for instance, @code{(height 5 width 15 left -1 top 1)}
+is such a plist.
+
+Here's a list of all possible keys for
+@code{gnus-buffer-configuration}:
+
+@code{group}, @code{summary}, @code{article}, @code{server},
+@code{browse}, @code{message}, @code{pick}, @code{info},
+@code{summary-faq}, @code{edit-group}, @code{edit-server},
+@code{edit-score}, @code{post}, @code{reply}, @code{forward},
+@code{reply-yank}, @code{mail-bounce}, @code{draft}, @code{pipe},
+@code{bug}, @code{compose-bounce}, and @code{score-trace}.
+
+Note that the @code{message} key is used for both
+@code{gnus-group-mail} and @code{gnus-summary-mail-other-window}. If
+it is desirable to distinguish between the two, something like this
+might be used:
+
+@lisp
+(message (horizontal 1.0
+ (vertical 1.0 (message 1.0 point))
+ (vertical 0.24
+ (if (buffer-live-p gnus-summary-buffer)
+ '(summary 0.5))
+ (group 1.0)))))
+@end lisp
+
+@findex gnus-add-configuration
+Since the @code{gnus-buffer-configuration} variable is so long and
+complicated, there's a function you can use to ease changing the config
+of a single setting: @code{gnus-add-configuration}. If, for instance,
+you want to change the @code{article} setting, you could say:
+
+@lisp
+(gnus-add-configuration
+ '(article (vertical 1.0
+ (group 4)
+ (summary .25 point)
+ (article 1.0))))
+@end lisp
+
+You'd typically stick these @code{gnus-add-configuration} calls in your
+@file{.gnus.el} file or in some startup hook---they should be run after
+Gnus has been loaded.
+
+@vindex gnus-always-force-window-configuration
+If all windows mentioned in the configuration are already visible, Gnus
+won't change the window configuration. If you always want to force the
+``right'' window configuration, you can set
+@code{gnus-always-force-window-configuration} to non-@code{nil}.
+
+
+@node Compilation
+@section Compilation
+@cindex compilation
+@cindex byte-compilation
+
+@findex gnus-compile
+
+Remember all those line format specification variables?
+@code{gnus-summary-line-format}, @code{gnus-group-line-format}, and so
+on. Now, Gnus will of course heed whatever these variables are, but,
+unfortunately, changing them will mean a quite significant slow-down.
+(The default values of these variables have byte-compiled functions
+associated with them, while the user-generated versions do not, of
+course.)
+
+To help with this, you can run @kbd{M-x gnus-compile} after you've
+fiddled around with the variables and feel that you're (kind of)
+satisfied. This will result in the new specs being byte-compiled, and
+you'll get top speed again. Gnus will save these compiled specs in the
+@file{.newsrc.eld} file. (User-defined functions aren't compiled by
+this function, though---you should compile them yourself by sticking
+them into the @code{.gnus.el} file and byte-compiling that file.)
+
+
+@node Mode Lines
+@section Mode Lines
+@cindex mode lines
+
+@vindex gnus-updated-mode-lines
+@code{gnus-updated-mode-lines} says what buffers should keep their mode
+lines updated. It is a list of symbols. Supported symbols include
+@code{group}, @code{article}, @code{summary}, @code{server},
+@code{browse}, and @code{tree}. If the corresponding symbol is present,
+Gnus will keep that mode line updated with information that may be
+pertinent. If this variable is @code{nil}, screen refresh may be
+quicker.
+
+@cindex display-time
+
+@vindex gnus-mode-non-string-length
+By default, Gnus displays information on the current article in the mode
+lines of the summary and article buffers. The information Gnus wishes
+to display (e.g. the subject of the article) is often longer than the
+mode lines, and therefore have to be cut off at some point. The
+@code{gnus-mode-non-string-length} variable says how long the other
+elements on the line is (i.e., the non-info part). If you put
+additional elements on the mode line (e.g. a clock), you should modify
+this variable:
+
+@c Hook written by Francesco Potorti` <pot@cnuce.cnr.it>
+@lisp
+(add-hook 'display-time-hook
+ (lambda () (setq gnus-mode-non-string-length
+ (+ 21
+ (if line-number-mode 5 0)
+ (if column-number-mode 4 0)
+ (length display-time-string)))))
+@end lisp
+
+If this variable is @code{nil} (which is the default), the mode line
+strings won't be chopped off, and they won't be padded either. Note
+that the default is unlikely to be desirable, as even the percentage
+complete in the buffer may be crowded off the mode line; the user should
+configure this variable appropriately for her configuration.
+
+
+@node Highlighting and Menus
+@section Highlighting and Menus
+@cindex visual
+@cindex highlighting
+@cindex menus
+
+@vindex gnus-visual
+The @code{gnus-visual} variable controls most of the Gnus-prettifying
+aspects. If @code{nil}, Gnus won't attempt to create menus or use fancy
+colors or fonts. This will also inhibit loading the @file{gnus-vis.el}
+file.
+
+This variable can be a list of visual properties that are enabled. The
+following elements are valid, and are all included by default:
+
+@table @code
+@item group-highlight
+Do highlights in the group buffer.
+@item summary-highlight
+Do highlights in the summary buffer.
+@item article-highlight
+Do highlights in the article buffer.
+@item highlight
+Turn on highlighting in all buffers.
+@item group-menu
+Create menus in the group buffer.
+@item summary-menu
+Create menus in the summary buffers.
+@item article-menu
+Create menus in the article buffer.
+@item browse-menu
+Create menus in the browse buffer.
+@item server-menu
+Create menus in the server buffer.
+@item score-menu
+Create menus in the score buffers.
+@item menu
+Create menus in all buffers.
+@end table
+
+So if you only want highlighting in the article buffer and menus in all
+buffers, you could say something like:
+
+@lisp
+(setq gnus-visual '(article-highlight menu))
+@end lisp
+
+If you want highlighting only and no menus whatsoever, you'd say:
+
+@lisp
+(setq gnus-visual '(highlight))
+@end lisp
+
+If @code{gnus-visual} is @code{t}, highlighting and menus will be used
+in all Gnus buffers.
+
+Other general variables that influence the look of all buffers include:
+
+@table @code
+@item gnus-mouse-face
+@vindex gnus-mouse-face
+This is the face (i.e., font) used for mouse highlighting in Gnus. No
+mouse highlights will be done if @code{gnus-visual} is @code{nil}.
+
+@end table
+
+There are hooks associated with the creation of all the different menus:
+
+@table @code
+
+@item gnus-article-menu-hook
+@vindex gnus-article-menu-hook
+Hook called after creating the article mode menu.
+
+@item gnus-group-menu-hook
+@vindex gnus-group-menu-hook
+Hook called after creating the group mode menu.
+
+@item gnus-summary-menu-hook
+@vindex gnus-summary-menu-hook
+Hook called after creating the summary mode menu.
+
+@item gnus-server-menu-hook
+@vindex gnus-server-menu-hook
+Hook called after creating the server mode menu.
+
+@item gnus-browse-menu-hook
+@vindex gnus-browse-menu-hook
+Hook called after creating the browse mode menu.
+
+@item gnus-score-menu-hook
+@vindex gnus-score-menu-hook
+Hook called after creating the score mode menu.
+
+@end table
+
+
+@node Buttons
+@section Buttons
+@cindex buttons
+@cindex mouse
+@cindex click
+
+Those new-fangled @dfn{mouse} contraptions is very popular with the
+young, hep kids who don't want to learn the proper way to do things
+these days. Why, I remember way back in the summer of '89, when I was
+using Emacs on a Tops 20 system. Three hundred users on one single
+machine, and every user was running Simula compilers. Bah!
+
+Right.
+
+@vindex gnus-carpal
+Well, you can make Gnus display bufferfuls of buttons you can click to
+do anything by setting @code{gnus-carpal} to @code{t}. Pretty simple,
+really. Tell the chiropractor I sent you.
+
+
+@table @code
+
+@item gnus-carpal-mode-hook
+@vindex gnus-carpal-mode-hook
+Hook run in all carpal mode buffers.
+
+@item gnus-carpal-button-face
+@vindex gnus-carpal-button-face
+Face used on buttons.
+
+@item gnus-carpal-header-face
+@vindex gnus-carpal-header-face
+Face used on carpal buffer headers.
+
+@item gnus-carpal-group-buffer-buttons
+@vindex gnus-carpal-group-buffer-buttons
+Buttons in the group buffer.
+
+@item gnus-carpal-summary-buffer-buttons
+@vindex gnus-carpal-summary-buffer-buttons
+Buttons in the summary buffer.
+
+@item gnus-carpal-server-buffer-buttons
+@vindex gnus-carpal-server-buffer-buttons
+Buttons in the server buffer.
+
+@item gnus-carpal-browse-buffer-buttons
+@vindex gnus-carpal-browse-buffer-buttons
+Buttons in the browse buffer.
+@end table
+
+All the @code{buttons} variables are lists. The elements in these list
+are either cons cells where the @code{car} contains a text to be displayed and
+the @code{cdr} contains a function symbol, or a simple string.
+
+
+@node Daemons
+@section Daemons
+@cindex demons
+@cindex daemons
+
+Gnus, being larger than any program ever written (allegedly), does lots
+of strange stuff that you may wish to have done while you're not
+present. For instance, you may want it to check for new mail once in a
+while. Or you may want it to close down all connections to all servers
+when you leave Emacs idle. And stuff like that.
+
+Gnus will let you do stuff like that by defining various
+@dfn{handlers}. Each handler consists of three elements: A
+@var{function}, a @var{time}, and an @var{idle} parameter.
+
+Here's an example of a handler that closes connections when Emacs has
+been idle for thirty minutes:
+
+@lisp
+(gnus-demon-close-connections nil 30)
+@end lisp
+
+Here's a handler that scans for PGP headers every hour when Emacs is
+idle:
+
+@lisp
+(gnus-demon-scan-pgp 60 t)
+@end lisp
+
+This @var{time} parameter and than @var{idle} parameter work together
+in a strange, but wonderful fashion. Basically, if @var{idle} is
+@code{nil}, then the function will be called every @var{time} minutes.
+
+If @var{idle} is @code{t}, then the function will be called after
+@var{time} minutes only if Emacs is idle. So if Emacs is never idle,
+the function will never be called. But once Emacs goes idle, the
+function will be called every @var{time} minutes.
+
+If @var{idle} is a number and @var{time} is a number, the function will
+be called every @var{time} minutes only when Emacs has been idle for
+@var{idle} minutes.
+
+If @var{idle} is a number and @var{time} is @code{nil}, the function
+will be called once every time Emacs has been idle for @var{idle}
+minutes.
+
+And if @var{time} is a string, it should look like @samp{07:31}, and
+the function will then be called once every day somewhere near that
+time. Modified by the @var{idle} parameter, of course.
+
+@vindex gnus-demon-timestep
+(When I say ``minute'' here, I really mean @code{gnus-demon-timestep}
+seconds. This is 60 by default. If you change that variable,
+all the timings in the handlers will be affected.)
+
+@vindex gnus-use-demon
+To set the whole thing in motion, though, you have to set
+@code{gnus-use-demon} to @code{t}.
+
+So, if you want to add a handler, you could put something like this in
+your @file{.gnus} file:
+
+@findex gnus-demon-add-handler
+@lisp
+(gnus-demon-add-handler 'gnus-demon-close-connections 30 t)
+@end lisp
+
+@findex gnus-demon-add-nocem
+@findex gnus-demon-add-scanmail
+@findex gnus-demon-add-rescan
+@findex gnus-demon-add-scan-timestamps
+@findex gnus-demon-add-disconnection
+Some ready-made functions to do this have been created:
+@code{gnus-demon-add-nocem}, @code{gnus-demon-add-disconnection},
+@code{gnus-demon-add-scan-timestamps}, @code{gnus-demon-add-rescan}, and
+@code{gnus-demon-add-scanmail}. Just put those functions in your
+@file{.gnus} if you want those abilities.
+
+@findex gnus-demon-init
+@findex gnus-demon-cancel
+@vindex gnus-demon-handlers
+If you add handlers to @code{gnus-demon-handlers} directly, you should
+run @code{gnus-demon-init} to make the changes take hold. To cancel all
+daemons, you can use the @code{gnus-demon-cancel} function.
+
+Note that adding daemons can be pretty naughty if you overdo it. Adding
+functions that scan all news and mail from all servers every two seconds
+is a sure-fire way of getting booted off any respectable system. So
+behave.
+
+
+@node NoCeM
+@section NoCeM
+@cindex nocem
+@cindex spam
+
+@dfn{Spamming} is posting the same article lots and lots of times.
+Spamming is bad. Spamming is evil.
+
+Spamming is usually canceled within a day or so by various anti-spamming
+agencies. These agencies usually also send out @dfn{NoCeM} messages.
+NoCeM is pronounced ``no see-'em'', and means what the name
+implies---these are messages that make the offending articles, like, go
+away.
+
+What use are these NoCeM messages if the articles are canceled anyway?
+Some sites do not honor cancel messages and some sites just honor cancels
+from a select few people. Then you may wish to make use of the NoCeM
+messages, which are distributed in the @samp{alt.nocem.misc} newsgroup.
+
+Gnus can read and parse the messages in this group automatically, and
+this will make spam disappear.
+
+There are some variables to customize, of course:
+
+@table @code
+@item gnus-use-nocem
+@vindex gnus-use-nocem
+Set this variable to @code{t} to set the ball rolling. It is @code{nil}
+by default.
+
+@item gnus-nocem-groups
+@vindex gnus-nocem-groups
+Gnus will look for NoCeM messages in the groups in this list. The
+default is @code{("news.lists.filters" "news.admin.net-abuse.bulletins"
+"alt.nocem.misc" "news.admin.net-abuse.announce")}.
+
+@item gnus-nocem-issuers
+@vindex gnus-nocem-issuers
+There are many people issuing NoCeM messages. This list says what
+people you want to listen to. The default is @code{("Automoose-1"
+"clewis@@ferret.ocunix.on.ca;" "jem@@xpat.com;" "red@@redpoll.mrfs.oh.us
+(Richard E. Depew)")}; fine, upstanding citizens all of them.
+
+Known despammers that you can put in this list include:
+
+@table @samp
+@item clewis@@ferret.ocunix.on.ca;
+@cindex Chris Lewis
+Chris Lewis---Major Canadian despammer who has probably canceled more
+usenet abuse than anybody else.
+
+@item Automoose-1
+@cindex CancelMoose[tm]
+The CancelMoose[tm] on autopilot. The CancelMoose[tm] is reputed to be
+Norwegian, and was the person(s) who invented NoCeM.
+
+@item jem@@xpat.com;
+@cindex Jem
+John Milburn---despammer located in Korea who is getting very busy these
+days.
+
+@item red@@redpoll.mrfs.oh.us (Richard E. Depew)
+Richard E. Depew---lone American despammer. He mostly cancels binary
+postings to non-binary groups and removes spews (regurgitated articles).
+@end table
+
+You do not have to heed NoCeM messages from all these people---just the
+ones you want to listen to. You also don't have to accept all NoCeM
+messages from the people you like. Each NoCeM message has a @dfn{type}
+header that gives the message a (more or less, usually less) rigorous
+definition. Common types are @samp{spam}, @samp{spew}, @samp{mmf},
+@samp{binary}, and @samp{troll}. To specify this, you have to use
+@var{(issuer conditions ...)} elements in the list. Each condition is
+either a string (which is a regexp that matches types you want to use)
+or a list on the form @code{(not STRING)}, where @var{string} is a
+regexp that matches types you don't want to use.
+
+For instance, if you want all NoCeM messages from Chris Lewis except his
+@samp{troll} messages, you'd say:
+
+@lisp
+("clewis@@ferret.ocunix.on.ca" ".*" (not "troll"))
+@end lisp
+
+On the other hand, if you just want nothing but his @samp{spam} and
+@samp{spew} messages, you'd say:
+
+@lisp
+("clewis@@ferret.ocunix.on.ca" (not ".*") "spew" "spam")
+@end lisp
+
+The specs are applied left-to-right.
+
+
+@item gnus-nocem-verifyer
+@vindex gnus-nocem-verifyer
+@findex mc-verify
+This should be a function for verifying that the NoCeM issuer is who she
+says she is. The default is @code{mc-verify}, which is a Mailcrypt
+function. If this is too slow and you don't care for verification
+(which may be dangerous), you can set this variable to @code{nil}.
+
+If you want signed NoCeM messages to be verified and unsigned messages
+not to be verified (but used anyway), you could do something like:
+
+@lisp
+(setq gnus-nocem-verifyer 'my-gnus-mc-verify)
+
+(defun my-gnus-mc-verify ()
+ (not (eq 'forged
+ (ignore-errors
+ (if (mc-verify)
+ t
+ 'forged)))))
+@end lisp
+
+This might be dangerous, though.
+
+@item gnus-nocem-directory
+@vindex gnus-nocem-directory
+This is where Gnus will store its NoCeM cache files. The default is
+@file{~/News/NoCeM/}.
+
+@item gnus-nocem-expiry-wait
+@vindex gnus-nocem-expiry-wait
+The number of days before removing old NoCeM entries from the cache.
+The default is 15. If you make it shorter Gnus will be faster, but you
+might then see old spam.
+
+@end table
+
+Using NoCeM could potentially be a memory hog. If you have many living
+(i. e., subscribed or unsubscribed groups), your Emacs process will grow
+big. If this is a problem, you should kill off all (or most) of your
+unsubscribed groups (@pxref{Subscription Commands}).
+
+
+@node Undo
+@section Undo
+@cindex undo
+
+It is very useful to be able to undo actions one has done. In normal
+Emacs buffers, it's easy enough---you just push the @code{undo} button.
+In Gnus buffers, however, it isn't that simple.
+
+The things Gnus displays in its buffer is of no value whatsoever to
+Gnus---it's all just data designed to look nice to the user.
+Killing a group in the group buffer with @kbd{C-k} makes the line
+disappear, but that's just a side-effect of the real action---the
+removal of the group in question from the internal Gnus structures.
+Undoing something like that can't be done by the normal Emacs
+@code{undo} function.
+
+Gnus tries to remedy this somewhat by keeping track of what the user
+does and coming up with actions that would reverse the actions the user
+takes. When the user then presses the @code{undo} key, Gnus will run
+the code to reverse the previous action, or the previous actions.
+However, not all actions are easily reversible, so Gnus currently offers
+a few key functions to be undoable. These include killing groups,
+yanking groups, and changing the list of read articles of groups.
+That's it, really. More functions may be added in the future, but each
+added function means an increase in data to be stored, so Gnus will
+never be totally undoable.
+
+@findex gnus-undo-mode
+@vindex gnus-use-undo
+@findex gnus-undo
+The undoability is provided by the @code{gnus-undo-mode} minor mode. It
+is used if @code{gnus-use-undo} is non-@code{nil}, which is the
+default. The @kbd{M-C-_} key performs the @code{gnus-undo} command
+command, which should feel kinda like the normal Emacs @code{undo}
+command.
+
+
+@node Moderation
+@section Moderation
+@cindex moderation
+
+If you are a moderator, you can use the @file{gnus-mdrtn.el} package.
+It is not included in the standard Gnus package. Write a mail to
+@samp{larsi@@gnus.org} and state what group you moderate, and you'll
+get a copy.
+
+The moderation package is implemented as a minor mode for summary
+buffers. Put
+
+@lisp
+(add-hook 'gnus-summary-mode-hook 'gnus-moderate)
+@end lisp
+
+in your @file{.gnus.el} file.
+
+If you are the moderator of @samp{rec.zoofle}, this is how it's
+supposed to work:
+
+@enumerate
+@item
+You split your incoming mail by matching on
+@samp{Newsgroups:.*rec.zoofle}, which will put all the to-be-posted
+articles in some mail group---for instance, @samp{nnml:rec.zoofle}.
+
+@item
+You enter that group once in a while and post articles using the @kbd{e}
+(edit-and-post) or @kbd{s} (just send unedited) commands.
+
+@item
+If, while reading the @samp{rec.zoofle} newsgroup, you happen upon some
+articles that weren't approved by you, you can cancel them with the
+@kbd{c} command.
+@end enumerate
+
+To use moderation mode in these two groups, say:
+
+@lisp
+(setq gnus-moderated-list
+ "^nnml:rec.zoofle$\\|^rec.zoofle$")
+@end lisp
+
+
+@node XEmacs Enhancements
+@section XEmacs Enhancements
+@cindex XEmacs
+
+XEmacs is able to display pictures and stuff, so Gnus has taken
+advantage of that.
+
+@menu
+* Picons:: How to display pictures of what your reading.
+* Smileys:: Show all those happy faces the way they were meant to be shown.
+* Toolbar:: Click'n'drool.
+* XVarious:: Other XEmacsy Gnusey variables.
+@end menu
+
+
+@node Picons
+@subsection Picons
+
+@iftex
+@iflatex
+\gnuspicon{tmp/picons-att.ps}
+\gnuspicon{tmp/picons-berkeley.ps}
+\gnuspicon{tmp/picons-caltech.ps}
+\gnuspicon{tmp/picons-canada.ps}
+\gnuspicon{tmp/picons-cr.ps}
+\gnuspicon{tmp/picons-cygnus.ps}
+\gnuspicon{tmp/picons-gov.ps}
+\gnuspicon{tmp/picons-mit.ps}
+\gnuspicon{tmp/picons-nasa.ps}
+\gnuspicon{tmp/picons-qmw.ps}
+\gnuspicon{tmp/picons-rms.ps}
+\gnuspicon{tmp/picons-ruu.ps}
+@end iflatex
+@end iftex
+
+So... You want to slow down your news reader even more! This is a
+good way to do so. Its also a great way to impress people staring
+over your shoulder as you read news.
+
+@menu
+* Picon Basics:: What are picons and How do I get them.
+* Picon Requirements:: Don't go further if you aren't using XEmacs.
+* Easy Picons:: Displaying Picons---the easy way.
+* Hard Picons:: The way you should do it. You'll learn something.
+* Picon Configuration:: Other variables you can trash/tweak/munge/play with.
+@end menu
+
+
+@node Picon Basics
+@subsubsection Picon Basics
+
+What are Picons? To quote directly from the Picons Web site:
+
+@quotation
+@dfn{Picons} is short for ``personal icons''. They're small,
+constrained images used to represent users and domains on the net,
+organized into databases so that the appropriate image for a given
+e-mail address can be found. Besides users and domains, there are picon
+databases for Usenet newsgroups and weather forecasts. The picons are
+in either monochrome @code{XBM} format or color @code{XPM} and
+@code{GIF} formats.
+@end quotation
+
+For instructions on obtaining and installing the picons databases, point
+your Web browser at
+@file{http://www.cs.indiana.edu/picons/ftp/index.html}.
+
+@vindex gnus-picons-database
+Gnus expects picons to be installed into a location pointed to by
+@code{gnus-picons-database}.
+
+
+@node Picon Requirements
+@subsubsection Picon Requirements
+
+To have Gnus display Picons for you, you must be running XEmacs
+19.13 or greater since all other versions of Emacs aren't yet able to
+display images.
+
+Additionally, you must have @code{xpm} support compiled into XEmacs.
+
+@vindex gnus-picons-convert-x-face
+If you want to display faces from @code{X-Face} headers, you must have
+the @code{netpbm} utilities installed, or munge the
+@code{gnus-picons-convert-x-face} variable to use something else.
+
+
+@node Easy Picons
+@subsubsection Easy Picons
+
+To enable displaying picons, simply put the following line in your
+@file{~/.gnus} file and start Gnus.
+
+@lisp
+(setq gnus-use-picons t)
+(add-hook 'gnus-article-display-hook 'gnus-article-display-picons t)
+(add-hook 'gnus-summary-prepare-hook 'gnus-group-display-picons t)
+(add-hook 'gnus-article-display-hook 'gnus-picons-article-display-x-face)
+@end lisp
+
+
+@node Hard Picons
+@subsubsection Hard Picons
+
+Gnus can display picons for you as you enter and leave groups and
+articles. It knows how to interact with three sections of the picons
+database. Namely, it can display the picons newsgroup pictures,
+author's face picture(s), and the authors domain. To enable this
+feature, you need to first decide where to display them.
+
+@table @code
+
+@item gnus-picons-display-where
+@vindex gnus-picons-display-where
+Where the picon images should be displayed. It is @code{picons} by
+default (which by default maps to the buffer @samp{*Picons*}). Other
+valid places could be @code{article}, @code{summary}, or
+@samp{*scratch*} for all I care. Just make sure that you've made the
+buffer visible using the standard Gnus window configuration
+routines---@pxref{Windows Configuration}.
+
+@end table
+
+@iftex
+@iflatex
+\gnuspicon{tmp/picons-seuu.ps}
+\gnuspicon{tmp/picons-stanford.ps}
+\gnuspicon{tmp/picons-sun.ps}
+\gnuspicon{tmp/picons-ubc.ps}
+\gnuspicon{tmp/picons-ufl.ps}
+\gnuspicon{tmp/picons-uio.ps}
+\gnuspicon{tmp/picons-unit.ps}
+\gnuspicon{tmp/picons-upenn.ps}
+\gnuspicon{tmp/picons-wesleyan.ps}
+@end iflatex
+@end iftex
+
+Note: If you set @code{gnus-use-picons} to @code{t}, it will set up your
+window configuration for you to include the @code{picons} buffer.
+
+Now that you've made that decision, you need to add the following
+functions to the appropriate hooks so these pictures will get
+displayed at the right time.
+
+@vindex gnus-article-display-hook
+@vindex gnus-picons-display-where
+@table @code
+@item gnus-article-display-picons
+@findex gnus-article-display-picons
+Looks up and displays the picons for the author and the author's domain
+in the @code{gnus-picons-display-where} buffer. Should be added to the
+@code{gnus-article-display-hook}.
+
+@item gnus-group-display-picons
+@findex gnus-article-display-picons
+Displays picons representing the current group. This function should
+be added to the @code{gnus-summary-prepare-hook} or to the
+@code{gnus-article-display-hook} if @code{gnus-picons-display-where}
+is set to @code{article}.
+
+@item gnus-picons-article-display-x-face
+@findex gnus-article-display-picons
+Decodes and displays the X-Face header if present. This function
+should be added to @code{gnus-article-display-hook}.
+
+@end table
+
+Note: You must append them to the hook, so make sure to specify 't'
+for the append flag of @code{add-hook}:
+
+@lisp
+(add-hook 'gnus-article-display-hook 'gnus-article-display-picons t)
+@end lisp
+
+
+@node Picon Configuration
+@subsubsection Picon Configuration
+
+The following variables offer further control over how things are
+done, where things are located, and other useless stuff you really
+don't need to worry about.
+
+@table @code
+@item gnus-picons-database
+@vindex gnus-picons-database
+The location of the picons database. Should point to a directory
+containing the @file{news}, @file{domains}, @file{users} (and so on)
+subdirectories. Defaults to @file{/usr/local/faces}.
+
+@item gnus-picons-news-directory
+@vindex gnus-picons-news-directory
+Sub-directory of the faces database containing the icons for
+newsgroups.
+
+@item gnus-picons-user-directories
+@vindex gnus-picons-user-directories
+List of subdirectories to search in @code{gnus-picons-database} for user
+faces. @code{("local" "users" "usenix" "misc")} is the default.
+
+@item gnus-picons-domain-directories
+@vindex gnus-picons-domain-directories
+List of subdirectories to search in @code{gnus-picons-database} for
+domain name faces. Defaults to @code{("domains")}. Some people may
+want to add @samp{unknown} to this list.
+
+@item gnus-picons-convert-x-face
+@vindex gnus-picons-convert-x-face
+The command to use to convert the @code{X-Face} header to an X bitmap
+(@code{xbm}). Defaults to @code{(format "@{ echo '/* Width=48,
+Height=48 */'; uncompface; @} | icontopbm | pbmtoxbm > %s"
+gnus-picons-x-face-file-name)}
+
+@item gnus-picons-x-face-file-name
+@vindex gnus-picons-x-face-file-name
+Names a temporary file to store the @code{X-Face} bitmap in. Defaults
+to @code{(format "/tmp/picon-xface.%s.xbm" (user-login-name))}.
+
+@item gnus-picons-buffer
+@vindex gnus-picons-buffer
+The name of the buffer that @code{picons} points to. Defaults to
+@samp{*Icon Buffer*}.
+
+@end table
+
+@node Smileys
+@subsection Smileys
+@cindex smileys
+
+@dfn{Smiley} is a package separate from Gnus, but since Gnus is
+currently the only package that uses Smiley, it is documented here.
+
+In short---to use Smiley in Gnus, put the following in your
+@file{.gnus.el} file:
+
+@lisp
+(add-hook 'gnus-article-display-hook 'gnus-smiley-display t)
+@end lisp
+
+Smiley maps text smiley faces---@samp{:-)}, @samp{:-=}, @samp{:-(} and
+the like---to pictures and displays those instead of the text smiley
+faces. The conversion is controlled by a list of regexps that matches
+text and maps that to file names.
+
+@vindex smiley-nosey-regexp-alist
+@vindex smiley-deformed-regexp-alist
+Smiley supplies two example conversion alists by default:
+@code{smiley-deformed-regexp-alist} (which matches @samp{:)}, @samp{:(}
+and so on), and @code{smiley-nosey-regexp-alist} (which matches
+@samp{:-)}, @samp{:-(} and so on).
+
+The alist used is specified by the @code{smiley-regexp-alist} variable,
+which defaults to the value of @code{smiley-deformed-regexp-alist}.
+
+Here's the default value of @code{smiley-smiley-regexp-alist}:
+
+@lisp
+(setq smiley-nosey-regexp-alist
+ '(("\\(:-+[<«]+\\)\\W" 1 "FaceAngry.xpm")
+ ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
+ ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm")
+ ("\\(:-+[@}»]+\\)\\W" 1 "FaceHappy.xpm")
+ ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm")
+ ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm")
+ ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
+ ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm")
+ ("\\(:-+[(@{]+\\)\\W" 1 "FaceSad.xpm")
+ ("\\(:-+[Oo\*]\\)\\W" 1 "FaceStartled.xpm")
+ ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm")
+ ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm")
+ ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm")
+ ("\\(;-+[>)@}»]+\\)\\W" 1 "FaceWinking.xpm")
+ ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm")
+ ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm")
+ ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")))
+@end lisp
+
+The first item in each element is the regexp to be matched; the second
+element is the regexp match group that is to be replaced by the picture;
+and the third element is the name of the file to be displayed.
+
+The following variables customize where Smiley will look for these
+files, as well as the color to be used and stuff:
+
+@table @code
+
+@item smiley-data-directory
+@vindex smiley-data-directory
+Where Smiley will look for smiley faces files.
+
+@item smiley-flesh-color
+@vindex smiley-flesh-color
+Skin color. The default is @samp{yellow}, which is really racist.
+
+@item smiley-features-color
+@vindex smiley-features-color
+Color of the features of the face. The default is @samp{black}.
+
+@item smiley-tongue-color
+@vindex smiley-tongue-color
+Color of the tongue. The default is @samp{red}.
+
+@item smiley-circle-color
+@vindex smiley-circle-color
+Color of the circle around the face. The default is @samp{black}.
+
+@item smiley-mouse-face
+@vindex smiley-mouse-face
+Face used for mouse highlighting over the smiley face.
+
+@end table
+
+
+@node Toolbar
+@subsection Toolbar
+
+@table @code
+
+@item gnus-use-toolbar
+@vindex gnus-use-toolbar
+If @code{nil}, don't display toolbars. If non-@code{nil}, it should be
+one of @code{default-toolbar}, @code{top-toolbar}, @code{bottom-toolbar},
+@code{right-toolbar}, or @code{left-toolbar}.
+
+@item gnus-group-toolbar
+@vindex gnus-group-toolbar
+The toolbar in the group buffer.
+
+@item gnus-summary-toolbar
+@vindex gnus-summary-toolbar
+The toolbar in the summary buffer.
+
+@item gnus-summary-mail-toolbar
+@vindex gnus-summary-mail-toolbar
+The toolbar in the summary buffer of mail groups.
+
+@end table
+
+
+@node XVarious
+@subsection Various XEmacs Variables
+
+@table @code
+@item gnus-xmas-glyph-directory
+@vindex gnus-xmas-glyph-directory
+This is where Gnus will look for pictures. Gnus will normally
+auto-detect this directory, but you may set it manually if you have an
+unusual directory structure.
+
+@item gnus-xmas-logo-color-alist
+@vindex gnus-xmas-logo-color-alist
+This is an alist where the key is a type symbol and the values are the
+foreground and background color of the splash page glyph.
+
+@item gnus-xmas-logo-color-style
+@vindex gnus-xmas-logo-color-style
+This is the key used to look up the color in the alist described above.
+Legal values include @code{flame}, @code{pine}, @code{moss},
+@code{irish}, @code{sky}, @code{tin}, @code{velvet}, @code{grape},
+@code{labia}, @code{berry}, @code{neutral}, and @code{september}.
+
+@item gnus-xmas-modeline-glyph
+@vindex gnus-xmas-modeline-glyph
+A glyph displayed in all Gnus mode lines. It is a tiny gnu head by
+default.
+
+@end table
+
+
+
+
+@node Fuzzy Matching
+@section Fuzzy Matching
+@cindex fuzzy matching
+
+Gnus provides @dfn{fuzzy matching} of @code{Subject} lines when doing
+things like scoring, thread gathering and thread comparison.
+
+As opposed to regular expression matching, fuzzy matching is very fuzzy.
+It's so fuzzy that there's not even a definition of what @dfn{fuzziness}
+means, and the implementation has changed over time.
+
+Basically, it tries to remove all noise from lines before comparing.
+@samp{Re: }, parenthetical remarks, white space, and so on, are filtered
+out of the strings before comparing the results. This often leads to
+adequate results---even when faced with strings generated by text
+manglers masquerading as newsreaders.
+
+
+@node Thwarting Email Spam
+@section Thwarting Email Spam
+@cindex email spam
+@cindex spam
+@cindex UCE
+@cindex unsolicited commercial email
+
+In these last days of the Usenet, commercial vultures are hanging about
+and grepping through news like crazy to find email addresses they can
+foist off their scams and products to. As a reaction to this, many
+people have started putting nonsense addresses into their @code{From}
+lines. I think this is counterproductive---it makes it difficult for
+people to send you legitimate mail in response to things you write, as
+well as making it difficult to see who wrote what. This rewriting may
+perhaps be a bigger menace than the unsolicited commercial email itself
+in the end.
+
+The biggest problem I have with email spam is that it comes in under
+false pretenses. I press @kbd{g} and Gnus merrily informs me that I
+have 10 new emails. I say ``Golly gee! Happy is me!'' and select the
+mail group, only to find two pyramid schemes, seven advertisements
+(``New! Miracle tonic for growing full, lustrouos hair on your toes!'')
+and one mail asking me to repent and find some god.
+
+This is annoying.
+
+The way to deal with this is having Gnus split out all spam into a
+@samp{spam} mail group (@pxref{Splitting Mail}).
+
+First, pick one (1) valid mail address that you can be reached at, and
+put it in your @code{From} header of all your news articles. (I've
+chosen @samp{larsi@@trym.ifi.uio.no}, but for many addresses on the form
+@samp{larsi+usenet@@ifi.uio.no} will be a better choice. Ask your
+sysadm whether your sendmail installation accepts keywords in the local
+part of the mail address.)
+
+@lisp
+(setq message-default-news-headers
+ "From: Lars Magne Ingebrigtsen <larsi@@trym.ifi.uio.no>\n")
+@end lisp
+
+Then put the following split rule in @code{nnmail-split-fancy}
+(@pxref{Fancy Mail Splitting}):
+
+@lisp
+(
+ ...
+ (to "larsi@@trym.ifi.uio.no"
+ (| ("subject" "re:.*" "misc")
+ ("references" ".*@@.*" "misc")
+ "spam"))
+ ...
+)
+@end lisp
+
+This says that all mail to this address is suspect, but if it has a
+@code{Subject} that starts with a @samp{Re:} or has a @code{References}
+header, it's probably ok. All the rest goes to the @samp{spam} group.
+(This idea probably comes from Tim Pierce.)
+
+In addition, many mail spammers talk directly to your @code{smtp} server
+and do not include your email address explicitly in the @code{To}
+header. Why they do this is unknown---perhaps it's to thwart this
+twarting scheme? In any case, this is trivial to deal with---you just
+put anything not addressed to you in the @samp{spam} group by ending
+your fancy split rule in this way:
+
+@lisp
+(
+ ...
+ (to "larsi" "misc")
+ "spam")
+@end lisp
+
+In my experience, this will sort virtually everything into the right
+group. You still have to check the @samp{spam} group from time to time to
+check for legitimate mail, though. If you feel like being a good net
+citizen, you can even send off complaints to the proper authorities on
+each unsolicited commercial email---at your leisure.
+
+If you are also a lazy net citizen, you will probably prefer complaining
+automatically with the @file{gnus-junk.el} package, availiable FOR FREE
+at @file{<URL:http://stud2.tuwien.ac.at/~e9426626/gnus-junk.html>}.
+Since most e-mail spam is sent automatically, this may reconcile the
+cosmic balance somewhat.
+
+This works for me. It allows people an easy way to contact me (they can
+just press @kbd{r} in the usual way), and I'm not bothered at all with
+spam. It's a win-win situation. Forging @code{From} headers to point
+to non-existant domains is yucky, in my opinion.
+
+
+@node Various Various
+@section Various Various
+@cindex mode lines
+@cindex highlights
+
+@table @code
+
+@item gnus-home-directory
+All Gnus path variables will be initialized from this variable, which
+defaults to @file{~/}.
+
+@item gnus-directory
+@vindex gnus-directory
+Most Gnus storage path variables will be initialized from this variable,
+which defaults to the @samp{SAVEDIR} environment variable, or
+@file{~/News/} if that variable isn't set.
+
+@item gnus-default-directory
+@vindex gnus-default-directory
+Not related to the above variable at all---this variable says what the
+default directory of all Gnus buffers should be. If you issue commands
+like @kbd{C-x C-f}, the prompt you'll get starts in the current buffer's
+default directory. If this variable is @code{nil} (which is the
+default), the default directory will be the default directory of the
+buffer you were in when you started Gnus.
+
+@item gnus-verbose
+@vindex gnus-verbose
+This variable is an integer between zero and ten. The higher the value,
+the more messages will be displayed. If this variable is zero, Gnus
+will never flash any messages, if it is seven (which is the default),
+most important messages will be shown, and if it is ten, Gnus won't ever
+shut up, but will flash so many messages it will make your head swim.
+
+@item gnus-verbose-backends
+@vindex gnus-verbose-backends
+This variable works the same way as @code{gnus-verbose}, but it applies
+to the Gnus backends instead of Gnus proper.
+
+@item nnheader-max-head-length
+@vindex nnheader-max-head-length
+When the backends read straight heads of articles, they all try to read
+as little as possible. This variable (default 4096) specifies
+the absolute max length the backends will try to read before giving up
+on finding a separator line between the head and the body. If this
+variable is @code{nil}, there is no upper read bound. If it is
+@code{t}, the backends won't try to read the articles piece by piece,
+but read the entire articles. This makes sense with some versions of
+@code{ange-ftp} or @code{efs}.
+
+@item nnheader-head-chop-length
+@vindex nnheader-head-chop-length
+This variable (default 2048) says how big a piece of each article to
+read when doing the operation described above.
+
+@item nnheader-file-name-translation-alist
+@vindex nnheader-file-name-translation-alist
+@cindex file names
+@cindex invalid characters in file names
+@cindex characters in file names
+This is an alist that says how to translate characters in file names.
+For instance, if @samp{:} is invalid as a file character in file names
+on your system (you OS/2 user you), you could say something like:
+
+@lisp
+(setq nnheader-file-name-translation-alist
+ '((?: . ?_)))
+@end lisp
+
+In fact, this is the default value for this variable on OS/2 and MS
+Windows (phooey) systems.
+
+@item gnus-hidden-properties
+@vindex gnus-hidden-properties
+This is a list of properties to use to hide ``invisible'' text. It is
+@code{(invisible t intangible t)} by default on most systems, which
+makes invisible text invisible and intangible.
+
+@item gnus-parse-headers-hook
+@vindex gnus-parse-headers-hook
+A hook called before parsing headers. It can be used, for instance, to
+gather statistics on the headers fetched, or perhaps you'd like to prune
+some headers. I don't see why you'd want that, though.
+
+@item gnus-shell-command-separator
+@vindex gnus-shell-command-separator
+String used to separate two shell commands. The default is @samp{;}.
+
+
+@end table
+
+
+@node The End
+@chapter The End
+
+Well, that's the manual---you can get on with your life now. Keep in
+touch. Say hello to your cats from me.
+
+My @strong{ghod}---I just can't stand goodbyes. Sniffle.
+
+Ol' Charles Reznikoff said it pretty well, so I leave the floor to him:
+
+@quotation
+@strong{Te Deum}
+
+@sp 1
+Not because of victories @*
+I sing,@*
+having none,@*
+but for the common sunshine,@*
+the breeze,@*
+the largess of the spring.
+
+@sp 1
+Not for victory@*
+but for the day's work done@*
+as well as I was able;@*
+not for a seat upon the dais@*
+but at the common table.@*
+@end quotation
+
+
+@node Appendices
+@chapter Appendices
+
+@menu
+* History:: How Gnus got where it is today.
+* Terminology:: We use really difficult, like, words here.
+* Customization:: Tailoring Gnus to your needs.
+* Troubleshooting:: What you might try if things do not work.
+* A Programmers Guide to Gnus:: Rilly, rilly technical stuff.
+* Emacs for Heathens:: A short introduction to Emacsian terms.
+* Frequently Asked Questions:: A question-and-answer session.
+@end menu
+
+
+@node History
+@section History
+
+@cindex history
+@sc{gnus} was written by Masanobu @sc{Umeda}. When autumn crept up in
+'94, Lars Magne Ingebrigtsen grew bored and decided to rewrite Gnus.
+
+If you want to investigate the person responsible for this outrage, you
+can point your (feh!) web browser to
+@file{http://www.ifi.uio.no/~larsi/}. This is also the primary
+distribution point for the new and spiffy versions of Gnus, and is known
+as The Site That Destroys Newsrcs And Drives People Mad.
+
+During the first extended alpha period of development, the new Gnus was
+called ``(ding) Gnus''. @dfn{(ding)} is, of course, short for
+@dfn{ding is not Gnus}, which is a total and utter lie, but who cares?
+(Besides, the ``Gnus'' in this abbreviation should probably be
+pronounced ``news'' as @sc{Umeda} intended, which makes it a more
+appropriate name, don't you think?)
+
+In any case, after spending all that energy on coming up with a new and
+spunky name, we decided that the name was @emph{too} spunky, so we
+renamed it back again to ``Gnus''. But in mixed case. ``Gnus'' vs.
+``@sc{gnus}''. New vs. old.
+
+The first ``proper'' release of Gnus 5 was done in November 1995 when it
+was included in the Emacs 19.30 distribution (132 (ding) Gnus releases
+plus 15 Gnus 5.0 releases).
+
+In May 1996 the next Gnus generation (aka. ``September Gnus'' (after 99
+releases)) was released under the name ``Gnus 5.2'' (40 releases).
+
+On July 28th 1996 work on Red Gnus was begun, and it was released on
+January 25th 1997 (after 84 releases) as ``Gnus 5.4''.
+
+If you happen upon a version of Gnus that has a prefixed name --
+``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia 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.
+
+@menu
+* Why?:: What's the point of Gnus?
+* Compatibility:: Just how compatible is Gnus with @sc{gnus}?
+* Conformity:: Gnus tries to conform to all standards.
+* Emacsen:: Gnus can be run on a few modern Emacsen.
+* Contributors:: Oodles of people.
+* New Features:: Pointers to some of the new stuff in Gnus.
+* Newest Features:: Features so new that they haven't been written yet.
+@end menu
+
+
+@node Why?
+@subsection Why?
+
+What's the point of Gnus?
+
+I want to provide a ``rad'', ``happening'', ``way cool'' and ``hep''
+newsreader, that lets you do anything you can think of. That was my
+original motivation, but while working on Gnus, it has become clear to
+me that this generation of newsreaders really belong in the stone age.
+Newsreaders haven't developed much since the infancy of the net. If the
+volume continues to rise with the current rate of increase, all current
+newsreaders will be pretty much useless. How do you deal with
+newsgroups that have thousands of new articles each day? How do you
+keep track of millions of people who post?
+
+Gnus offers no real solutions to these questions, but I would very much
+like to see Gnus being used as a testing ground for new methods of
+reading and fetching news. Expanding on @sc{Umeda}-san's wise decision
+to separate the newsreader from the backends, Gnus now offers a simple
+interface for anybody who wants to write new backends for fetching mail
+and news from different sources. I have added hooks for customizations
+everywhere I could imagine it being useful. By doing so, I'm inviting
+every one of you to explore and invent.
+
+May Gnus never be complete. @kbd{C-u 100 M-x all-hail-emacs} and
+@kbd{C-u 100 M-x all-hail-xemacs}.
+
+
+@node Compatibility
+@subsection Compatibility
+
+@cindex compatibility
+Gnus was designed to be fully compatible with @sc{gnus}. Almost all key
+bindings have been kept. More key bindings have been added, of course,
+but only in one or two obscure cases have old bindings been changed.
+
+Our motto is:
+@quotation
+@cartouche
+@center In a cloud bones of steel.
+@end cartouche
+@end quotation
+
+All commands have kept their names. Some internal functions have changed
+their names.
+
+The @code{gnus-uu} package has changed drastically. @xref{Decoding
+Articles}.
+
+One major compatibility question is the presence of several summary
+buffers. All variables relevant while reading a group are
+buffer-local to the summary buffer they belong in. Although many
+important variables have their values copied into their global
+counterparts whenever a command is executed in the summary buffer, this
+change might lead to incorrect values being used unless you are careful.
+
+All code that relies on knowledge of @sc{gnus} internals will probably
+fail. To take two examples: Sorting @code{gnus-newsrc-alist} (or
+changing it in any way, as a matter of fact) is strictly verboten. Gnus
+maintains a hash table that points to the entries in this alist (which
+speeds up many functions), and changing the alist directly will lead to
+peculiar results.
+
+@cindex hilit19
+@cindex highlighting
+Old hilit19 code does not work at all. In fact, you should probably
+remove all hilit code from all Gnus hooks
+(@code{gnus-group-prepare-hook} and @code{gnus-summary-prepare-hook}).
+Gnus provides various integrated functions for highlighting. These are
+faster and more accurate. To make life easier for everybody, Gnus will
+by default remove all hilit calls from all hilit hooks. Uncleanliness!
+Away!
+
+Packages like @code{expire-kill} will no longer work. As a matter of
+fact, you should probably remove all old @sc{gnus} packages (and other
+code) when you start using Gnus. More likely than not, Gnus already
+does what you have written code to make @sc{gnus} do. (Snicker.)
+
+Even though old methods of doing things are still supported, only the
+new methods are documented in this manual. If you detect a new method of
+doing something while reading this manual, that does not mean you have
+to stop doing it the old way.
+
+Gnus understands all @sc{gnus} startup files.
+
+@kindex M-x gnus-bug
+@findex gnus-bug
+@cindex reporting bugs
+@cindex bugs
+Overall, a casual user who hasn't written much code that depends on
+@sc{gnus} internals should suffer no problems. If problems occur,
+please let me know by issuing that magic command @kbd{M-x gnus-bug}.
+
+
+@node Conformity
+@subsection Conformity
+
+No rebels without a clue here, ma'am. We conform to all standards known
+to (wo)man. Except for those standards and/or conventions we disagree
+with, of course.
+
+@table @strong
+
+@item RFC 822
+@cindex RFC 822
+There are no known breaches of this standard.
+
+@item RFC 1036
+@cindex RFC 1036
+There are no known breaches of this standard, either.
+
+@item Good Net-Keeping Seal of Approval
+@cindex Good Net-Keeping Seal of Approval
+Gnus has been through the Seal process and failed. I think it'll pass
+the next inspection.
+
+@item Son-of-RFC 1036
+@cindex Son-of-RFC 1036
+We do have some breaches to this one.
+
+@table @emph
+
+@item MIME
+Gnus does no MIME handling, and this standard-to-be seems to think that
+MIME is the bees' knees, so we have major breakage here.
+
+@item X-Newsreader
+This is considered to be a ``vanity header'', while I consider it to be
+consumer information. After seeing so many badly formatted articles
+coming from @code{tin} and @code{Netscape} I know not to use either of
+those for posting articles. I would not have known that if it wasn't
+for the @code{X-Newsreader} header.
+@end table
+
+@end table
+
+If you ever notice Gnus acting non-compliant with regards to the texts
+mentioned above, don't hesitate to drop a note to Gnus Towers and let us
+know.
+
+
+@node Emacsen
+@subsection Emacsen
+@cindex Emacsen
+@cindex XEmacs
+@cindex Mule
+@cindex Emacs
+
+Gnus should work on :
+
+@itemize @bullet
+
+@item
+Emacs 19.32 and up.
+
+@item
+XEmacs 19.14 and up.
+
+@item
+Mule versions based on Emacs 19.32 and up.
+
+@end itemize
+
+Gnus will absolutely not work on any Emacsen older than that. Not
+reliably, at least.
+
+There are some vague differences between Gnus on the various
+platforms---XEmacs features more graphics (a logo and a toolbar)---but
+other than that, things should look pretty much the same under all
+Emacsen.
+
+
+@node Contributors
+@subsection Contributors
+@cindex contributors
+
+The new Gnus version couldn't have been done without the help of all the
+people on the (ding) mailing list. Every day for over a year I have
+gotten billions of nice bug reports from them, filling me with joy,
+every single one of them. Smooches. The people on the list have been
+tried beyond endurance, what with my ``oh, that's a neat idea <type
+type>, yup, I'll release it right away <ship off> no wait, that doesn't
+work at all <type type>, yup, I'll ship that one off right away <ship
+off> no, wait, that absolutely does not work'' policy for releases.
+Micro$oft---bah. Amateurs. I'm @emph{much} worse. (Or is that
+``worser''? ``much worser''? ``worsest''?)
+
+I would like to take this opportunity to thank the Academy for... oops,
+wrong show.
+
+@itemize @bullet
+
+@item
+Masanobu @sc{Umeda}---the writer of the original @sc{gnus}.
+
+@item
+Per Abrahamsen---custom, scoring, highlighting and @sc{soup} code (as
+well as numerous other things).
+
+@item
+Luis Fernandes---design and graphics.
+
+@item
+Erik Naggum---help, ideas, support, code and stuff.
+
+@item
+Wes Hardaker---@file{gnus-picon.el} and the manual section on
+@dfn{picons} (@pxref{Picons}).
+
+@item
+Kim-Minh Kaplan---further work on the picon code.
+
+@item
+Brad Miller---@file{gnus-gl.el} and the GroupLens manual section
+(@pxref{GroupLens}).
+
+@item
+Sudish Joseph---innumerable bug fixes.
+
+@item
+Ilja Weis---@file{gnus-topic.el}.
+
+@item
+Steven L. Baur---lots and lots and lots of bugs detections and fixes.
+
+@item
+Vladimir Alexiev---the refcard and reference booklets.
+
+@item
+Felix Lee & Jamie Zawinsky---I stole some pieces from the XGnus
+distribution by Felix Lee and JWZ.
+
+@item
+Scott Byer---@file{nnfolder.el} enhancements & rewrite.
+
+@item
+Peter Mutsaers---orphan article scoring code.
+
+@item
+Ken Raeburn---POP mail support.
+
+@item
+Hallvard B Furuseth---various bits and pieces, especially dealing with
+.newsrc files.
+
+@item
+Brian Edmonds---@file{gnus-bbdb.el}.
+
+@item
+David Moore---rewrite of @file{nnvirtual.el} and many other things.
+
+@item
+Kevin Davidson---came up with the name @dfn{ding}, so blame him.
+
+@item
+François Pinard---many, many interesting and thorough bug reports.
+
+@end itemize
+
+This manual was proof-read by Adrian Aichner, with Ricardo Nassif, Mark
+Borges, and Jost Krieger proof-reading parts of the manual.
+
+The following people have contributed many patches and suggestions:
+
+Christopher Davis,
+Andrew Eskilsson,
+Kai Grossjohann,
+David Kågedal,
+Richard Pieri,
+Fabrice Popineau,
+Daniel Quinlan,
+Jason L. Tibbitts, III,
+and
+Jack Vinson.
+
+Also thanks to the following for patches and stuff:
+
+Adrian Aichner,
+Peter Arius,
+Matt Armstrong,
+Marc Auslander,
+Robert Bihlmeyer,
+Chris Bone,
+Mark Borges,
+Mark Boyns,
+Lance A. Brown,
+Kees de Bruin,
+Martin Buchholz,
+Kevin Buhr,
+Alastair Burt,
+Joao Cachopo,
+Zlatko Calusic,
+Massimo Campostrini,
+Dan Christensen,
+Michael R. Cook,
+Glenn Coombs,
+Frank D. Cringle,
+Geoffrey T. Dairiki,
+Andre Deparade,
+Ulrik Dickow,
+Dave Disser,
+Joev Dubach,
+Michael Welsh Duggan,
+Paul Eggert,
+Michael Ernst,
+Luc Van Eycken,
+Sam Falkner,
+Nelson Jose dos Santos Ferreira,
+Sigbjorn Finne,
+Gary D. Foster,
+Paul Franklin,
+Guy Geens,
+Arne Georg Gleditsch,
+David S. Goldberg,
+Michelangelo Grigni,
+D. Hall,
+Magnus Hammerin,
+Raja R. Harinath,
+Hisashige Kenji, @c Hisashige
+Marc Horowitz,
+Gunnar Horrigmo,
+Brad Howes,
+François Felix Ingrand,
+Ishikawa Ichiro, @c Ishikawa
+Lee Iverson,
+Rajappa Iyer,
+Andreas Jaeger,
+Randell Jesup,
+Fred Johansen,
+Greg Klanderman,
+Karl Kleinpaste,
+Peter Skov Knudsen,
+Shuhei Kobayashi, @c Kobayashi
+Thor Kristoffersen,
+Jens Lautenbacher,
+Carsten Leonhardt,
+James LewisMoss,
+Christian Limpach,
+Markus Linnala,
+Dave Love,
+Tonny Madsen,
+Shlomo Mahlab,
+Nat Makarevitch,
+David Martin,
+Gordon Matzigkeit,
+Timo Metzemakers,
+Richard Mlynarik,
+Lantz Moore,
+Morioka Tomohiko, @c Morioka
+Erik Toubro Nielsen,
+Hrvoje Niksic,
+Andy Norman,
+C. R. Oldham,
+Alexandre Oliva,
+Ken Olstad,
+Masaharu Onishi, @c Onishi
+Hideki Ono, @c Ono
+William Perry,
+Stephen Peters,
+Ulrich Pfeifer,
+John McClary Prevost,
+Colin Rafferty,
+Bart Robinson,
+Jason Rumney,
+Jay Sachs,
+Dewey M. Sasser,
+Loren Schall,
+Dan Schmidt,
+Ralph Schleicher,
+Philippe Schnoebelen,
+Randal L. Schwartz,
+Justin Sheehy,
+Danny Siu,
+Matt Simmons,
+Paul D. Smith,
+Jeff Sparkes,
+Toby Speight,
+Michael Sperber,
+Darren Stalder,
+Richard Stallman,
+Greg Stark,
+Paul Stodghill,
+Kurt Swanson,
+Samuel Tardieu,
+Teddy,
+Chuck Thompson,
+Philippe Troin,
+James Troup,
+Enami Tsugutomo, @c ?
+Aaron M. Ucko,
+Jan Vroonhof,
+Barry A. Warsaw,
+Christoph Wedler,
+Joe Wells,
+and
+Katsumi Yamaoka. @c Yamaoka
+
+For a full overview of what each person has done, the ChangeLogs
+included in the Gnus alpha distributions should give ample reading
+(550kB and counting).
+
+Apologies to everybody that I've forgotten, of which there are many, I'm
+sure.
+
+Gee, that's quite a list of people. I guess that must mean that there
+actually are people who are using Gnus. Who'd'a thunk it!
+
+
+@node New Features
+@subsection New Features
+@cindex new features
+
+@menu
+* ding Gnus:: New things in Gnus 5.0/5.1, the first new Gnus.
+* September Gnus:: The Thing Formally Known As Gnus 5.3/5.3.
+* Red Gnus:: Third time best---Gnus 5.4/5.5.
+@end menu
+
+These lists are, of course, just @emph{short} overviews of the
+@emph{most} important new features. No, really. There are tons more.
+Yes, we have feeping creaturism in full effect.
+
+
+@node ding Gnus
+@subsubsection (ding) Gnus
+
+New features in Gnus 5.0/5.1:
+
+@itemize @bullet
+
+@item
+The look of all buffers can be changed by setting format-like variables
+(@pxref{Group Buffer Format} and @pxref{Summary Buffer Format}).
+
+@item
+Local spool and several @sc{nntp} servers can be used at once
+(@pxref{Select Methods}).
+
+@item
+You can combine groups into virtual groups (@pxref{Virtual Groups}).
+
+@item
+You can read a number of different mail formats (@pxref{Getting Mail}).
+All the mail backends implement a convenient mail expiry scheme
+(@pxref{Expiring Mail}).
+
+@item
+Gnus can use various strategies for gathering threads that have lost
+their roots (thereby gathering loose sub-threads into one thread) or it
+can go back and retrieve enough headers to build a complete thread
+(@pxref{Customizing Threading}).
+
+@item
+Killed groups can be displayed in the group buffer, and you can read
+them as well (@pxref{Listing Groups}).
+
+@item
+Gnus can do partial group updates---you do not have to retrieve the
+entire active file just to check for new articles in a few groups
+(@pxref{The Active File}).
+
+@item
+Gnus implements a sliding scale of subscribedness to groups
+(@pxref{Group Levels}).
+
+@item
+You can score articles according to any number of criteria
+(@pxref{Scoring}). You can even get Gnus to find out how to score
+articles for you (@pxref{Adaptive Scoring}).
+
+@item
+Gnus maintains a dribble buffer that is auto-saved the normal Emacs
+manner, so it should be difficult to lose much data on what you have
+read if your machine should go down (@pxref{Auto Save}).
+
+@item
+Gnus now has its own startup file (@file{.gnus}) to avoid cluttering up
+the @file{.emacs} file.
+
+@item
+You can set the process mark on both groups and articles and perform
+operations on all the marked items (@pxref{Process/Prefix}).
+
+@item
+You can grep through a subset of groups and create a group from the
+results (@pxref{Kibozed Groups}).
+
+@item
+You can list subsets of groups according to, well, anything
+(@pxref{Listing Groups}).
+
+@item
+You can browse foreign servers and subscribe to groups from those
+servers (@pxref{Browse Foreign Server}).
+
+@item
+Gnus can fetch articles, asynchronously, on a second connection to the
+server (@pxref{Asynchronous Fetching}).
+
+@item
+You can cache articles locally (@pxref{Article Caching}).
+
+@item
+The uudecode functions have been expanded and generalized
+(@pxref{Decoding Articles}).
+
+@item
+You can still post uuencoded articles, which was a little-known feature
+of @sc{gnus}' past (@pxref{Uuencoding and Posting}).
+
+@item
+Fetching parents (and other articles) now actually works without
+glitches (@pxref{Finding the Parent}).
+
+@item
+Gnus can fetch FAQs and group descriptions (@pxref{Group Information}).
+
+@item
+Digests (and other files) can be used as the basis for groups
+(@pxref{Document Groups}).
+
+@item
+Articles can be highlighted and customized (@pxref{Customizing
+Articles}).
+
+@item
+URLs and other external references can be buttonized (@pxref{Article
+Buttons}).
+
+@item
+You can do lots of strange stuff with the Gnus window & frame
+configuration (@pxref{Windows Configuration}).
+
+@item
+You can click on buttons instead of using the keyboard
+(@pxref{Buttons}).
+
+@end itemize
+
+
+@node September Gnus
+@subsubsection September Gnus
+
+New features in Gnus 5.2/5.3:
+
+@itemize @bullet
+
+@item
+A new message composition mode is used. All old customization variables
+for @code{mail-mode}, @code{rnews-reply-mode} and @code{gnus-msg} are
+now obsolete.
+
+@item
+Gnus is now able to generate @dfn{sparse} threads---threads where
+missing articles are represented by empty nodes (@pxref{Customizing
+Threading}).
+
+@lisp
+(setq gnus-build-sparse-threads 'some)
+@end lisp
+
+@item
+Outgoing articles are stored on a special archive server
+(@pxref{Archived Messages}).
+
+@item
+Partial thread regeneration now happens when articles are
+referred.
+
+@item
+Gnus can make use of GroupLens predictions (@pxref{GroupLens}).
+
+@item
+Picons (personal icons) can be displayed under XEmacs (@pxref{Picons}).
+
+@item
+A @code{trn}-like tree buffer can be displayed (@pxref{Tree Display}).
+
+@lisp
+(setq gnus-use-trees t)
+@end lisp
+
+@item
+An @code{nn}-like pick-and-read minor mode is available for the summary
+buffers (@pxref{Pick and Read}).
+
+@lisp
+(add-hook 'gnus-summary-mode-hook 'gnus-pick-mode)
+@end lisp
+
+@item
+In binary groups you can use a special binary minor mode (@pxref{Binary
+Groups}).
+
+@item
+Groups can be grouped in a folding topic hierarchy (@pxref{Group
+Topics}).
+
+@lisp
+(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
+@end lisp
+
+@item
+Gnus can re-send and bounce mail (@pxref{Summary Mail Commands}).
+
+@item
+Groups can now have a score, and bubbling based on entry frequency
+is possible (@pxref{Group Score}).
+
+@lisp
+(add-hook 'gnus-summary-exit-hook 'gnus-summary-bubble-group)
+@end lisp
+
+@item
+Groups can be process-marked, and commands can be performed on
+groups of groups (@pxref{Marking Groups}).
+
+@item
+Caching is possible in virtual groups.
+
+@item
+@code{nndoc} now understands all kinds of digests, mail boxes, rnews
+news batches, ClariNet briefs collections, and just about everything
+else (@pxref{Document Groups}).
+
+@item
+Gnus has a new backend (@code{nnsoup}) to create/read SOUP packets
+(@pxref{SOUP}).
+
+@item
+The Gnus cache is much faster.
+
+@item
+Groups can be sorted according to many criteria (@pxref{Sorting
+Groups}).
+
+@item
+New group parameters have been introduced to set list-addresses and
+expiry times (@pxref{Group Parameters}).
+
+@item
+All formatting specs allow specifying faces to be used
+(@pxref{Formatting Fonts}).
+
+@item
+There are several more commands for setting/removing/acting on process
+marked articles on the @kbd{M P} submap (@pxref{Setting Process Marks}).
+
+@item
+The summary buffer can be limited to show parts of the available
+articles based on a wide range of criteria. These commands have been
+bound to keys on the @kbd{/} submap (@pxref{Limiting}).
+
+@item
+Articles can be made persistent with the @kbd{*} command
+(@pxref{Persistent Articles}).
+
+@item
+All functions for hiding article elements are now toggles.
+
+@item
+Article headers can be buttonized (@pxref{Article Washing}).
+
+@lisp
+(add-hook 'gnus-article-display-hook
+ 'gnus-article-add-buttons-to-head)
+@end lisp
+
+@item
+All mail backends support fetching articles by @code{Message-ID}.
+
+@item
+Duplicate mail can now be treated properly (@pxref{Duplicates}).
+
+@item
+All summary mode commands are available directly from the article
+buffer (@pxref{Article Keymap}).
+
+@item
+Frames can be part of @code{gnus-buffer-configuration} (@pxref{Windows
+Configuration}).
+
+@item
+Mail can be re-scanned by a daemonic process (@pxref{Daemons}).
+
+@item
+Gnus can make use of NoCeM files to weed out spam (@pxref{NoCeM}).
+
+@lisp
+(setq gnus-use-nocem t)
+@end lisp
+
+@item
+Groups can be made permanently visible (@pxref{Listing Groups}).
+
+@lisp
+(setq gnus-permanently-visible-groups "^nnml:")
+@end lisp
+
+@item
+Many new hooks have been introduced to make customizing easier.
+
+@item
+Gnus respects the @code{Mail-Copies-To} header.
+
+@item
+Threads can be gathered by looking at the @code{References} header
+(@pxref{Customizing Threading}).
+
+@lisp
+(setq gnus-summary-thread-gathering-function
+ 'gnus-gather-threads-by-references)
+@end lisp
+
+@item
+Read articles can be stored in a special backlog buffer to avoid
+refetching (@pxref{Article Backlog}).
+
+@lisp
+(setq gnus-keep-backlog 50)
+@end lisp
+
+@item
+A clean copy of the current article is always stored in a separate
+buffer to allow easier treatment.
+
+@item
+Gnus can suggest where to save articles (@pxref{Saving Articles}).
+
+@item
+Gnus doesn't have to do as much prompting when saving (@pxref{Saving
+Articles}).
+
+@lisp
+(setq gnus-prompt-before-saving t)
+@end lisp
+
+@item
+@code{gnus-uu} can view decoded files asynchronously while fetching
+articles (@pxref{Other Decode Variables}).
+
+@lisp
+(setq gnus-uu-grabbed-file-functions 'gnus-uu-grab-view)
+@end lisp
+
+@item
+Filling in the article buffer now works properly on cited text
+(@pxref{Article Washing}).
+
+@item
+Hiding cited text adds buttons to toggle hiding, and how much
+cited text to hide is now customizable (@pxref{Article Hiding}).
+
+@lisp
+(setq gnus-cited-lines-visible 2)
+@end lisp
+
+@item
+Boring headers can be hidden (@pxref{Article Hiding}).
+
+@lisp
+(add-hook 'gnus-article-display-hook
+ 'gnus-article-hide-boring-headers t)
+@end lisp
+
+@item
+Default scoring values can now be set from the menu bar.
+
+@item
+Further syntax checking of outgoing articles have been added.
+
+@end itemize
+
+
+@node Red Gnus
+@subsubsection Red Gnus
+
+New features in Gnus 5.4/5.5:
+
+@itemize @bullet
+
+@item
+@file{nntp.el} has been totally rewritten in an asynchronous fashion.
+
+@item
+Article prefetching functionality has been moved up into
+Gnus (@pxref{Asynchronous Fetching}).
+
+@item
+Scoring can now be performed with logical operators like @code{and},
+@code{or}, @code{not}, and parent redirection (@pxref{Advanced
+Scoring}).
+
+@item
+Article washing status can be displayed in the
+article mode line (@pxref{Misc Article}).
+
+@item
+@file{gnus.el} has been split into many smaller files.
+
+@item
+Suppression of duplicate articles based on Message-ID can be done
+(@pxref{Duplicate Suppression}).
+
+@lisp
+(setq gnus-suppress-duplicates t)
+@end lisp
+
+@item
+New variables for specifying what score and adapt files are to be
+considered home score and adapt files (@pxref{Home Score File}) have
+been added.
+
+@item
+@code{nndoc} was rewritten to be easily extendable (@pxref{Document
+Server Internals}).
+
+@item
+Groups can inherit group parameters from parent topics (@pxref{Topic
+Parameters}).
+
+@item
+Article editing has been revamped and is now actually usable.
+
+@item
+Signatures can be recognized in more intelligent fashions
+(@pxref{Article Signature}).
+
+@item
+Summary pick mode has been made to look more @code{nn}-like. Line
+numbers are displayed and the @kbd{.} command can be used to pick
+articles (@code{Pick and Read}).
+
+@item
+Commands for moving the @file{.newsrc.eld} from one server to
+another have been added (@pxref{Changing Servers}).
+
+@item
+There's a way now to specify that ``uninteresting'' fields be suppressed
+when generating lines in buffers (@pxref{Advanced Formatting}).
+
+@item
+Several commands in the group buffer can be undone with @kbd{M-C-_}
+(@pxref{Undo}).
+
+@item
+Scoring can be done on words using the new score type @code{w}
+(@pxref{Score File Format}).
+
+@item
+Adaptive scoring can be done on a Subject word-by-word basis
+(@pxref{Adaptive Scoring}).
+
+@lisp
+(setq gnus-use-adaptive-scoring '(word))
+@end lisp
+
+@item
+Scores can be decayed (@pxref{Score Decays}).
+
+@lisp
+(setq gnus-decay-scores t)
+@end lisp
+
+@item
+Scoring can be performed using a regexp on the Date header. The Date is
+normalized to compact ISO 8601 format first (@pxref{Score File Format}).
+
+@item
+A new command has been added to remove all data on articles from
+the native server (@pxref{Changing Servers}).
+
+@item
+A new command for reading collections of documents
+(@code{nndoc} with @code{nnvirtual} on top) has been added---@kbd{M-C-d}
+(@pxref{Really Various Summary Commands}).
+
+@item
+Process mark sets can be pushed and popped (@pxref{Setting Process
+Marks}).
+
+@item
+A new mail-to-news backend makes it possible to post even when the NNTP
+server doesn't allow posting (@pxref{Mail-To-News Gateways}).
+
+@item
+A new backend for reading searches from Web search engines
+(@dfn{DejaNews}, @dfn{Alta Vista}, @dfn{InReference}) has been added
+(@pxref{Web Searches}).
+
+@item
+Groups inside topics can now be sorted using the standard sorting
+functions, and each topic can be sorted independently (@pxref{Topic
+Sorting}).
+
+@item
+Subsets of the groups can be sorted independently (@code{Sorting
+Groups}).
+
+@item
+Cached articles can be pulled into the groups (@pxref{Summary Generation
+Commands}).
+
+@item
+Score files are now applied in a more reliable order (@pxref{Score
+Variables}).
+
+@item
+Reports on where mail messages end up can be generated (@pxref{Splitting
+Mail}).
+
+@item
+More hooks and functions have been added to remove junk from incoming
+mail before saving the mail (@pxref{Washing Mail}).
+
+@item
+Emphasized text can be properly fontisized:
+
+@lisp
+(add-hook 'gnus-article-display-hook 'gnus-article-emphasize)
+@end lisp
+
+@end itemize
+
+
+@node Newest Features
+@subsection Newest Features
+@cindex todo
+
+Also known as the @dfn{todo list}. Sure to be implemented before the
+next millennium.
+
+Be afraid. Be very afraid.
+
+@itemize @bullet
+@item
+Native @sc{mime} support is something that should be done.
+@item
+Really do unbinhexing.
+@end itemize
+
+And much, much, much more. There is more to come than has already been
+implemented. (But that's always true, isn't it?)
+
+@file{<URL:http://www.ifi.uio.no/~larsi/rgnus/todo>} is where the actual
+up-to-the-second todo list is located, so if you're really curious, you
+could point your Web browser over that-a-way.
+
+@iftex
+
+@node The Manual
+@section The Manual
+@cindex colophon
+@cindex manual
+
+This manual was generated from a TeXinfo file and then run through
+either @code{texi2dvi}
+@iflatex
+or my own home-brewed TeXinfo to \LaTeX\ transformer,
+and then run through @code{latex} and @code{dvips}
+@end iflatex
+to get what you hold in your hands now.
+
+The following conventions have been used:
+
+@enumerate
+
+@item
+This is a @samp{string}
+
+@item
+This is a @kbd{keystroke}
+
+@item
+This is a @file{file}
+
+@item
+This is a @code{symbol}
+
+@end enumerate
+
+So if I were to say ``set @code{flargnoze} to @samp{yes}'', that would
+mean:
+
+@lisp
+(setq flargnoze "yes")
+@end lisp
+
+If I say ``set @code{flumphel} to @code{yes}'', that would mean:
+
+@lisp
+(setq flumphel 'yes)
+@end lisp
+
+@samp{yes} and @code{yes} are two @emph{very} different things---don't
+ever get them confused.
+
+@iflatex
+@c @head
+Of course, everything in this manual is of vital interest, so you should
+read it all. Several times. However, if you feel like skimming the
+manual, look for that gnu head you should see in the margin over
+there---it means that what's being discussed is of more importance than
+the rest of the stuff. (On the other hand, if everything is infinitely
+important, how can anything be more important than that? Just one more
+of the mysteries of this world, I guess.)
+@end iflatex
+
+@end iftex
+
+
+@node Terminology
+@section Terminology
+
+@cindex terminology
+@table @dfn
+
+@item news
+@cindex news
+This is what you are supposed to use this thing for---reading news.
+News is generally fetched from a nearby @sc{nntp} server, and is
+generally publicly available to everybody. If you post news, the entire
+world is likely to read just what you have written, and they'll all
+snigger mischievously. Behind your back.
+
+@item mail
+@cindex mail
+Everything that's delivered to you personally is mail. Some news/mail
+readers (like Gnus) blur the distinction between mail and news, but
+there is a difference. Mail is private. News is public. Mailing is
+not posting, and replying is not following up.
+
+@item reply
+@cindex reply
+Send a mail to the person who has written what you are reading.
+
+@item follow up
+@cindex follow up
+Post an article to the current newsgroup responding to the article you
+are reading.
+
+@item backend
+@cindex backend
+Gnus gets fed articles from a number of backends, both news and mail
+backends. Gnus does not handle the underlying media, so to speak---this
+is all done by the backends.
+
+@item native
+@cindex native
+Gnus will always use one method (and backend) as the @dfn{native}, or
+default, way of getting news.
+
+@item foreign
+@cindex foreign
+You can also have any number of foreign groups active at the same time.
+These are groups that use non-native non-secondary backends for getting
+news.
+
+@item secondary
+@cindex secondary
+Secondary backends are somewhere half-way between being native and being
+foreign, but they mostly act like they are native.
+
+@item article
+@cindex article
+A message that has been posted as news.
+
+@item mail message
+@cindex mail message
+A message that has been mailed.
+
+@item message
+@cindex message
+A mail message or news article
+
+@item head
+@cindex head
+The top part of a message, where administrative information (etc.) is
+put.
+
+@item body
+@cindex body
+The rest of an article. Everything not in the head is in the
+body.
+
+@item header
+@cindex header
+A line from the head of an article.
+
+@item headers
+@cindex headers
+A collection of such lines, or a collection of heads. Or even a
+collection of @sc{nov} lines.
+
+@item @sc{nov}
+@cindex nov
+When Gnus enters a group, it asks the backend for the headers of all
+unread articles in the group. Most servers support the News OverView
+format, which is more compact and much faster to read and parse than the
+normal @sc{head} format.
+
+@item level
+@cindex levels
+Each group is subscribed at some @dfn{level} or other (1-9). The ones
+that have a lower level are ``more'' subscribed than the groups with a
+higher level. In fact, groups on levels 1-5 are considered
+@dfn{subscribed}; 6-7 are @dfn{unsubscribed}; 8 are @dfn{zombies}; and 9
+are @dfn{killed}. Commands for listing groups and scanning for new
+articles will all use the numeric prefix as @dfn{working level}.
+
+@item killed groups
+@cindex killed groups
+No information on killed groups is stored or updated, which makes killed
+groups much easier to handle than subscribed groups.
+
+@item zombie groups
+@cindex zombie groups
+Just like killed groups, only slightly less dead.
+
+@item active file
+@cindex active file
+The news server has to keep track of what articles it carries, and what
+groups exist. All this information in stored in the active file, which
+is rather large, as you might surmise.
+
+@item bogus groups
+@cindex bogus groups
+A group that exists in the @file{.newsrc} file, but isn't known to the
+server (i.e., it isn't in the active file), is a @emph{bogus group}.
+This means that the group probably doesn't exist (any more).
+
+@item server
+@cindex server
+A machine one can connect to and get news (or mail) from.
+
+@item select method
+@cindex select method
+A structure that specifies the backend, the server and the virtual
+server settings.
+
+@item virtual server
+@cindex virtual server
+A named select method. Since a select method defines all there is to
+know about connecting to a (physical) server, taking the thing as a
+whole is a virtual server.
+
+@item washing
+@cindex washing
+Taking a buffer and running it through a filter of some sort. The
+result will (more often than not) be cleaner and more pleasing than the
+original.
+
+@item ephemeral groups
+@cindex ephemeral groups
+Most groups store data on what articles you have read. @dfn{Ephemeral}
+groups are groups that will have no data stored---when you exit the
+group, it'll disappear into the aether.
+
+@item solid groups
+@cindex solid groups
+This is the opposite of ephemeral groups. All groups listed in the
+group buffer are solid groups.
+
+@item sparse articles
+@cindex sparse articles
+These are article placeholders shown in the summary buffer when
+@code{gnus-build-sparse-threads} has been switched on.
+
+@item threading
+@cindex threading
+To put responses to articles directly after the articles they respond
+to---in a hierarchical fashion.
+
+@item root
+@cindex root
+@cindex thread root
+The first article in a thread is the root. It is the ancestor of all
+articles in the thread.
+
+@item parent
+@cindex parent
+An article that has responses.
+
+@item child
+@cindex child
+An article that responds to a different article---its parent.
+
+@item digest
+@cindex digest
+A collection of messages in one file. The most common digest format is
+specified by RFC1153.
+
+@end table
+
+
+@node Customization
+@section Customization
+@cindex general customization
+
+All variables are properly documented elsewhere in this manual. This
+section is designed to give general pointers on how to customize Gnus
+for some quite common situations.
+
+@menu
+* Slow/Expensive Connection:: You run a local Emacs and get the news elsewhere.
+* Slow Terminal Connection:: You run a remote Emacs.
+* Little Disk Space:: You feel that having large setup files is icky.
+* Slow Machine:: You feel like buying a faster machine.
+@end menu
+
+
+@node Slow/Expensive Connection
+@subsection Slow/Expensive @sc{nntp} Connection
+
+If you run Emacs on a machine locally, and get your news from a machine
+over some very thin strings, you want to cut down on the amount of data
+Gnus has to get from the @sc{nntp} server.
+
+@table @code
+
+@item gnus-read-active-file
+Set this to @code{nil}, which will inhibit Gnus from requesting the
+entire active file from the server. This file is often v. large. You
+also have to set @code{gnus-check-new-newsgroups} and
+@code{gnus-check-bogus-newsgroups} to @code{nil} to make sure that Gnus
+doesn't suddenly decide to fetch the active file anyway.
+
+@item gnus-nov-is-evil
+This one has to be @code{nil}. If not, grabbing article headers from
+the @sc{nntp} server will not be very fast. Not all @sc{nntp} servers
+support @sc{xover}; Gnus will detect this by itself.
+@end table
+
+
+@node Slow Terminal Connection
+@subsection Slow Terminal Connection
+
+Let's say you use your home computer for dialing up the system that runs
+Emacs and Gnus. If your modem is slow, you want to reduce (as much as
+possible) the amount of data sent over the wires.
+
+@table @code
+
+@item gnus-auto-center-summary
+Set this to @code{nil} to inhibit Gnus from re-centering the summary
+buffer all the time. If it is @code{vertical}, do only vertical
+re-centering. If it is neither @code{nil} nor @code{vertical}, do both
+horizontal and vertical recentering.
+
+@item gnus-visible-headers
+Cut down on the headers included in the articles to the
+minimum. You can, in fact, make do without them altogether---most of the
+useful data is in the summary buffer, anyway. Set this variable to
+@samp{^NEVVVVER} or @samp{From:}, or whatever you feel you need.
+
+@item gnus-article-display-hook
+Set this hook to all the available hiding commands:
+@lisp
+(setq gnus-article-display-hook
+ '(gnus-article-hide-headers gnus-article-hide-signature
+ gnus-article-hide-citation))
+@end lisp
+
+@item gnus-use-full-window
+By setting this to @code{nil}, you can make all the windows smaller.
+While this doesn't really cut down much generally, it means that you
+have to see smaller portions of articles before deciding that you didn't
+want to read them anyway.
+
+@item gnus-thread-hide-subtree
+If this is non-@code{nil}, all threads in the summary buffer will be
+hidden initially.
+
+@item gnus-updated-mode-lines
+If this is @code{nil}, Gnus will not put information in the buffer mode
+lines, which might save some time.
+@end table
+
+
+@node Little Disk Space
+@subsection Little Disk Space
+@cindex disk space
+
+The startup files can get rather large, so you may want to cut their
+sizes a bit if you are running out of space.
+
+@table @code
+
+@item gnus-save-newsrc-file
+If this is @code{nil}, Gnus will never save @file{.newsrc}---it will
+only save @file{.newsrc.eld}. This means that you will not be able to
+use any other newsreaders than Gnus. This variable is @code{t} by
+default.
+
+@item gnus-save-killed-list
+If this is @code{nil}, Gnus will not save the list of dead groups. You
+should also set @code{gnus-check-new-newsgroups} to @code{ask-server}
+and @code{gnus-check-bogus-newsgroups} to @code{nil} if you set this
+variable to @code{nil}. This variable is @code{t} by default.
+
+@end table
+
+
+@node Slow Machine
+@subsection Slow Machine
+@cindex slow machine
+
+If you have a slow machine, or are just really impatient, there are a
+few things you can do to make Gnus run faster.
+
+Set @code{gnus-check-new-newsgroups} and
+@code{gnus-check-bogus-newsgroups} to @code{nil} to make startup faster.
+
+Set @code{gnus-show-threads}, @code{gnus-use-cross-reference} and
+@code{gnus-nov-is-evil} to @code{nil} to make entering and exiting the
+summary buffer faster.
+
+Set @code{gnus-article-display-hook} to @code{nil} to make article
+processing a bit faster.
+
+
+@node Troubleshooting
+@section Troubleshooting
+@cindex troubleshooting
+
+Gnus works @emph{so} well straight out of the box---I can't imagine any
+problems, really.
+
+Ahem.
+
+@enumerate
+
+@item
+Make sure your computer is switched on.
+
+@item
+Make sure that you really load the current Gnus version. If you have
+been running @sc{gnus}, you need to exit Emacs and start it up again before
+Gnus will work.
+
+@item
+Try doing an @kbd{M-x gnus-version}. If you get something that looks
+like @samp{Gnus v5.46; nntp 4.0} you have the right files loaded. If,
+on the other hand, you get something like @samp{NNTP 3.x} or @samp{nntp
+flee}, you have some old @file{.el} files lying around. Delete these.
+
+@item
+Read the help group (@kbd{G h} in the group buffer) for a FAQ and a
+how-to.
+
+@item
+@vindex max-lisp-eval-depth
+Gnus works on many recursive structures, and in some extreme (and very
+rare) cases Gnus may recurse down ``too deeply'' and Emacs will beep at
+you. If this happens to you, set @code{max-lisp-eval-depth} to 500 or
+something like that.
+@end enumerate
+
+If all else fails, report the problem as a bug.
+
+@cindex bugs
+@cindex reporting bugs
+
+@kindex M-x gnus-bug
+@findex gnus-bug
+If you find a bug in Gnus, you can report it with the @kbd{M-x gnus-bug}
+command. @kbd{M-x set-variable RET debug-on-error RET t RET}, and send
+me the backtrace. I will fix bugs, but I can only fix them if you send
+me a precise description as to how to reproduce the bug.
+
+You really can never be too detailed in a bug report. Always use the
+@kbd{M-x gnus-bug} command when you make bug reports, even if it creates
+a 10Kb mail each time you use it, and even if you have sent me your
+environment 500 times before. I don't care. I want the full info each
+time.
+
+It is also important to remember that I have no memory whatsoever. If
+you send a bug report, and I send you a reply, and then you just send
+back ``No, it's not! Moron!'', I will have no idea what you are
+insulting me about. Always over-explain everything. It's much easier
+for all of us---if I don't have all the information I need, I will just
+mail you and ask for more info, and everything takes more time.
+
+If the problem you're seeing is very visual, and you can't quite explain
+it, copy the Emacs window to a file (with @code{xwd}, for instance), put
+it somewhere it can be reached, and include the URL of the picture in
+the bug report.
+
+If you just need help, you are better off asking on
+@samp{gnu.emacs.gnus}. I'm not very helpful.
+
+@cindex gnu.emacs.gnus
+@cindex ding mailing list
+You can also ask on the ding mailing list---@samp{ding@@gnus.org}.
+Write to @samp{ding-request@@gnus.org} to subscribe.
+
+
+@node A Programmers Guide to Gnus
+@section A Programmer@'s Guide to Gnus
+
+It is my hope that other people will figure out smart stuff that Gnus
+can do, and that other people will write those smart things as well. To
+facilitate that I thought it would be a good idea to describe the inner
+workings of Gnus. And some of the not-so-inner workings, while I'm at
+it.
+
+You can never expect the internals of a program not to change, but I
+will be defining (in some details) the interface between Gnus and its
+backends (this is written in stone), the format of the score files
+(ditto), data structures (some are less likely to change than others)
+and general methods of operation.
+
+@menu
+* Gnus Utility Functions:: Common functions and variable to use.
+* Backend Interface:: How Gnus communicates with the servers.
+* Score File Syntax:: A BNF definition of the score file standard.
+* Headers:: How Gnus stores headers internally.
+* Ranges:: A handy format for storing mucho numbers.
+* Group Info:: The group info format.
+* Extended Interactive:: Symbolic prefixes and stuff.
+* Emacs/XEmacs Code:: Gnus can be run under all modern Emacsen.
+* Various File Formats:: Formats of files that Gnus use.
+@end menu
+
+
+@node Gnus Utility Functions
+@subsection Gnus Utility Functions
+@cindex Gnus utility functions
+@cindex utility functions
+@cindex functions
+@cindex internal variables
+
+When writing small functions to be run from hooks (and stuff), it's
+vital to have access to the Gnus internal functions and variables.
+Below is a list of the most common ones.
+
+@table @code
+
+@item gnus-newsgroup-name
+@vindex gnus-newsgroup-name
+This variable holds the name of the current newsgroup.
+
+@item gnus-find-method-for-group
+@findex gnus-find-method-for-group
+A function that returns the select method for @var{group}.
+
+@item gnus-group-real-name
+@findex gnus-group-real-name
+Takes a full (prefixed) Gnus group name, and returns the unprefixed
+name.
+
+@item gnus-group-prefixed-name
+@findex gnus-group-prefixed-name
+Takes an unprefixed group name and a select method, and returns the full
+(prefixed) Gnus group name.
+
+@item gnus-get-info
+@findex gnus-get-info
+Returns the group info list for @var{group}.
+
+@item gnus-add-current-to-buffer-list
+@findex gnus-add-current-to-buffer-list
+Adds the current buffer to the list of buffers to be killed on Gnus
+exit.
+
+@item gnus-continuum-version
+@findex gnus-continuum-version
+Takes a Gnus version string as a parameter and returns a floating point
+number. Earlier versions will always get a lower number than later
+versions.
+
+@item gnus-group-read-only-p
+@findex gnus-group-read-only-p
+Says whether @var{group} is read-only or not.
+
+@item gnus-news-group-p
+@findex gnus-news-group-p
+Says whether @var{group} came from a news backend.
+
+@item gnus-ephemeral-group-p
+@findex gnus-ephemeral-group-p
+Says whether @var{group} is ephemeral or not.
+
+@item gnus-server-to-method
+@findex gnus-server-to-method
+Returns the select method corresponding to @var{server}.
+
+@item gnus-server-equal
+@findex gnus-server-equal
+Says whether two virtual servers are equal.
+
+@item gnus-group-native-p
+@findex gnus-group-native-p
+Says whether @var{group} is native or not.
+
+@item gnus-group-secondary-p
+@findex gnus-group-secondary-p
+Says whether @var{group} is secondary or not.
+
+@item gnus-group-foreign-p
+@findex gnus-group-foreign-p
+Says whether @var{group} is foreign or not.
+
+@item group-group-find-parameter
+@findex group-group-find-parameter
+Returns the parameter list of @var{group}. If given a second parameter,
+returns the value of that parameter for @var{group}.
+
+@item gnus-group-set-parameter
+@findex gnus-group-set-parameter
+Takes three parameters; @var{group}, @var{parameter} and @var{value}.
+
+@item gnus-narrow-to-body
+@findex gnus-narrow-to-body
+Narrows the current buffer to the body of the article.
+
+@item gnus-check-backend-function
+@findex gnus-check-backend-function
+Takes two parameters, @var{function} and @var{group}. If the backend
+@var{group} comes from supports @var{function}, return non-@code{nil}.
+
+@lisp
+(gnus-check-backend-function "request-scan" "nnml:misc")
+=> t
+@end lisp
+
+@item gnus-read-method
+@findex gnus-read-method
+Prompts the user for a select method.
+
+@end table
+
+
+@node Backend Interface
+@subsection Backend Interface
+
+Gnus doesn't know anything about @sc{nntp}, spools, mail or virtual
+groups. It only knows how to talk to @dfn{virtual servers}. A virtual
+server is a @dfn{backend} and some @dfn{backend variables}. As examples
+of the first, we have @code{nntp}, @code{nnspool} and @code{nnmbox}. As
+examples of the latter we have @code{nntp-port-number} and
+@code{nnmbox-directory}.
+
+When Gnus asks for information from a backend---say @code{nntp}---on
+something, it will normally include a virtual server name in the
+function parameters. (If not, the backend should use the ``current''
+virtual server.) For instance, @code{nntp-request-list} takes a virtual
+server as its only (optional) parameter. If this virtual server hasn't
+been opened, the function should fail.
+
+Note that a virtual server name has no relation to some physical server
+name. Take this example:
+
+@lisp
+(nntp "odd-one"
+ (nntp-address "ifi.uio.no")
+ (nntp-port-number 4324))
+@end lisp
+
+Here the virtual server name is @samp{odd-one} while the name of
+the physical server is @samp{ifi.uio.no}.
+
+The backends should be able to switch between several virtual servers.
+The standard backends implement this by keeping an alist of virtual
+server environments that they pull down/push up when needed.
+
+There are two groups of interface functions: @dfn{required functions},
+which must be present, and @dfn{optional functions}, which Gnus will
+always check for presence before attempting to call 'em.
+
+All these functions are expected to return data in the buffer
+@code{nntp-server-buffer} (@samp{ *nntpd*}), which is somewhat
+unfortunately named, but we'll have to live with it. When I talk about
+@dfn{resulting data}, I always refer to the data in that buffer. When I
+talk about @dfn{return value}, I talk about the function value returned by
+the function call. Functions that fail should return @code{nil} as the
+return value.
+
+Some backends could be said to be @dfn{server-forming} backends, and
+some might be said not to be. The latter are backends that generally
+only operate on one group at a time, and have no concept of ``server''
+-- they have a group, and they deliver info on that group and nothing
+more.
+
+In the examples and definitions I will refer to the imaginary backend
+@code{nnchoke}.
+
+@cindex @code{nnchoke}
+
+@menu
+* Required Backend Functions:: Functions that must be implemented.
+* Optional Backend Functions:: Functions that need not be implemented.
+* Error Messaging:: How to get messages and report errors.
+* Writing New Backends:: Extending old backends.
+* Hooking New Backends Into Gnus:: What has to be done on the Gnus end.
+* Mail-like Backends:: Some tips on mail backends.
+@end menu
+
+
+@node Required Backend Functions
+@subsubsection Required Backend Functions
+
+@table @code
+
+@item (nnchoke-retrieve-headers ARTICLES &optional GROUP SERVER FETCH-OLD)
+
+@var{articles} is either a range of article numbers or a list of
+@code{Message-ID}s. Current backends do not fully support either---only
+sequences (lists) of article numbers, and most backends do not support
+retrieval of @code{Message-ID}s. But they should try for both.
+
+The result data should either be HEADs or NOV lines, and the result
+value should either be @code{headers} or @code{nov} to reflect this.
+This might later be expanded to @code{various}, which will be a mixture
+of HEADs and NOV lines, but this is currently not supported by Gnus.
+
+If @var{fetch-old} is non-@code{nil} it says to try fetching "extra
+headers", in some meaning of the word. This is generally done by
+fetching (at most) @var{fetch-old} extra headers less than the smallest
+article number in @code{articles}, and filling the gaps as well. The
+presence of this parameter can be ignored if the backend finds it
+cumbersome to follow the request. If this is non-@code{nil} and not a
+number, do maximum fetches.
+
+Here's an example HEAD:
+
+@example
+221 1056 Article retrieved.
+Path: ifi.uio.no!sturles
+From: sturles@@ifi.uio.no (Sturle Sunde)
+Newsgroups: ifi.discussion
+Subject: Re: Something very droll
+Date: 27 Oct 1994 14:02:57 +0100
+Organization: Dept. of Informatics, University of Oslo, Norway
+Lines: 26
+Message-ID: <38o8e1$a0o@@holmenkollen.ifi.uio.no>
+References: <38jdmq$4qu@@visbur.ifi.uio.no>
+NNTP-Posting-Host: holmenkollen.ifi.uio.no
+.
+@end example
+
+So a @code{headers} return value would imply that there's a number of
+these in the data buffer.
+
+Here's a BNF definition of such a buffer:
+
+@example
+headers = *head
+head = error / valid-head
+error-message = [ "4" / "5" ] 2number " " <error message> eol
+valid-head = valid-message *header "." eol
+valid-message = "221 " <number> " Article retrieved." eol
+header = <text> eol
+@end example
+
+If the return value is @code{nov}, the data buffer should contain
+@dfn{network overview database} lines. These are basically fields
+separated by tabs.
+
+@example
+nov-buffer = *nov-line
+nov-line = 8*9 [ field <TAB> ] eol
+field = <text except TAB>
+@end example
+
+For a closer look at what should be in those fields,
+@pxref{Headers}.
+
+
+@item (nnchoke-open-server SERVER &optional DEFINITIONS)
+
+@var{server} is here the virtual server name. @var{definitions} is a
+list of @code{(VARIABLE VALUE)} pairs that define this virtual server.
+
+If the server can't be opened, no error should be signaled. The backend
+may then choose to refuse further attempts at connecting to this
+server. In fact, it should do so.
+
+If the server is opened already, this function should return a
+non-@code{nil} value. There should be no data returned.
+
+
+@item (nnchoke-close-server &optional SERVER)
+
+Close connection to @var{server} and free all resources connected
+to it. Return @code{nil} if the server couldn't be closed for some
+reason.
+
+There should be no data returned.
+
+
+@item (nnchoke-request-close)
+
+Close connection to all servers and free all resources that the backend
+have reserved. All buffers that have been created by that backend
+should be killed. (Not the @code{nntp-server-buffer}, though.) This
+function is generally only called when Gnus is shutting down.
+
+There should be no data returned.
+
+
+@item (nnchoke-server-opened &optional SERVER)
+
+If @var{server} is the current virtual server, and the connection to the
+physical server is alive, then this function should return a
+non-@code{nil} vlue. This function should under no circumstances
+attempt to reconnect to a server we have lost connection to.
+
+There should be no data returned.
+
+
+@item (nnchoke-status-message &optional SERVER)
+
+This function should return the last error message from @var{server}.
+
+There should be no data returned.
+
+
+@item (nnchoke-request-article ARTICLE &optional GROUP SERVER TO-BUFFER)
+
+The result data from this function should be the article specified by
+@var{article}. This might either be a @code{Message-ID} or a number.
+It is optional whether to implement retrieval by @code{Message-ID}, but
+it would be nice if that were possible.
+
+If @var{to-buffer} is non-@code{nil}, the result data should be returned
+in this buffer instead of the normal data buffer. This is to make it
+possible to avoid copying large amounts of data from one buffer to
+another, while Gnus mainly requests articles to be inserted directly
+into its article buffer.
+
+If it is at all possible, this function should return a cons cell where
+the @code{car} is the group name the article was fetched from, and the @code{cdr} is
+the article number. This will enable Gnus to find out what the real
+group and article numbers are when fetching articles by
+@code{Message-ID}. If this isn't possible, @code{t} should be returned
+on successful article retrieval.
+
+
+@item (nnchoke-request-group GROUP &optional SERVER FAST)
+
+Get data on @var{group}. This function also has the side effect of
+making @var{group} the current group.
+
+If @var{FAST}, don't bother to return useful data, just make @var{group}
+the current group.
+
+Here's an example of some result data and a definition of the same:
+
+@example
+211 56 1000 1059 ifi.discussion
+@end example
+
+The first number is the status, which should be 211. Next is the
+total number of articles in the group, the lowest article number, the
+highest article number, and finally the group name. Note that the total
+number of articles may be less than one might think while just
+considering the highest and lowest article numbers, but some articles
+may have been canceled. Gnus just discards the total-number, so
+whether one should take the bother to generate it properly (if that is a
+problem) is left as an exercise to the reader.
+
+@example
+group-status = [ error / info ] eol
+error = [ "4" / "5" ] 2<number> " " <Error message>
+info = "211 " 3* [ <number> " " ] <string>
+@end example
+
+
+@item (nnchoke-close-group GROUP &optional SERVER)
+
+Close @var{group} and free any resources connected to it. This will be
+a no-op on most backends.
+
+There should be no data returned.
+
+
+@item (nnchoke-request-list &optional SERVER)
+
+Return a list of all groups available on @var{server}. And that means
+@emph{all}.
+
+Here's an example from a server that only carries two groups:
+
+@example
+ifi.test 0000002200 0000002000 y
+ifi.discussion 3324 3300 n
+@end example
+
+On each line we have a group name, then the highest article number in
+that group, the lowest article number, and finally a flag.
+
+@example
+active-file = *active-line
+active-line = name " " <number> " " <number> " " flags eol
+name = <string>
+flags = "n" / "y" / "m" / "x" / "j" / "=" name
+@end example
+
+The flag says whether the group is read-only (@samp{n}), is moderated
+(@samp{m}), is dead (@samp{x}), is aliased to some other group
+(@samp{=other-group}) or none of the above (@samp{y}).
+
+
+@item (nnchoke-request-post &optional SERVER)
+
+This function should post the current buffer. It might return whether
+the posting was successful or not, but that's not required. If, for
+instance, the posting is done asynchronously, it has generally not been
+completed by the time this function concludes. In that case, this
+function should set up some kind of sentinel to beep the user loud and
+clear if the posting could not be completed.
+
+There should be no result data from this function.
+
+@end table
+
+
+@node Optional Backend Functions
+@subsubsection Optional Backend Functions
+
+@table @code
+
+@item (nnchoke-retrieve-groups GROUPS &optional SERVER)
+
+@var{groups} is a list of groups, and this function should request data
+on all those groups. How it does it is of no concern to Gnus, but it
+should attempt to do this in a speedy fashion.
+
+The return value of this function can be either @code{active} or
+@code{group}, which says what the format of the result data is. The
+former is in the same format as the data from
+@code{nnchoke-request-list}, while the latter is a buffer full of lines
+in the same format as @code{nnchoke-request-group} gives.
+
+@example
+group-buffer = *active-line / *group-status
+@end example
+
+
+@item (nnchoke-request-update-info GROUP INFO &optional SERVER)
+
+A Gnus group info (@pxref{Group Info}) is handed to the backend for
+alterations. This comes in handy if the backend really carries all the
+information (as is the case with virtual and imap groups). This
+function should destructively alter the info to suit its needs, and
+should return the (altered) group info.
+
+There should be no result data from this function.
+
+
+@item (nnchoke-request-type GROUP &optional ARTICLE)
+
+When the user issues commands for ``sending news'' (@kbd{F} in the
+summary buffer, for instance), Gnus has to know whether the article the
+user is following up on is news or mail. This function should return
+@code{news} if @var{article} in @var{group} is news, @code{mail} if it
+is mail and @code{unknown} if the type can't be decided. (The
+@var{article} parameter is necessary in @code{nnvirtual} groups which
+might very well combine mail groups and news groups.) Both @var{group}
+and @var{article} may be @code{nil}.
+
+There should be no result data from this function.
+
+
+@item (nnchoke-request-update-mark GROUP ARTICLE MARK)
+
+If the user tries to set a mark that the backend doesn't like, this
+function may change the mark. Gnus will use whatever this function
+returns as the mark for @var{article} instead of the original
+@var{mark}. If the backend doesn't care, it must return the original
+@var{mark}, and not @code{nil} or any other type of garbage.
+
+The only use for this I can see is what @code{nnvirtual} does with
+it---if a component group is auto-expirable, marking an article as read
+in the virtual group should result in the article being marked as
+expirable.
+
+There should be no result data from this function.
+
+
+@item (nnchoke-request-scan &optional GROUP SERVER)
+
+This function may be called at any time (by Gnus or anything else) to
+request that the backend check for incoming articles, in one way or
+another. A mail backend will typically read the spool file or query the
+POP server when this function is invoked. The @var{group} doesn't have
+to be heeded---if the backend decides that it is too much work just
+scanning for a single group, it may do a total scan of all groups. It
+would be nice, however, to keep things local if that's practical.
+
+There should be no result data from this function.
+
+
+@item (nnchoke-request-group-description GROUP &optional SERVER)
+
+The result data from this function should be a description of
+@var{group}.
+
+@example
+description-line = name <TAB> description eol
+name = <string>
+description = <text>
+@end example
+
+@item (nnchoke-request-list-newsgroups &optional SERVER)
+
+The result data from this function should be the description of all
+groups available on the server.
+
+@example
+description-buffer = *description-line
+@end example
+
+
+@item (nnchoke-request-newgroups DATE &optional SERVER)
+
+The result data from this function should be all groups that were
+created after @samp{date}, which is in normal human-readable date
+format. The data should be in the active buffer format.
+
+
+@item (nnchoke-request-create-group GROUP &optional SERVER)
+
+This function should create an empty group with name @var{group}.
+
+There should be no return data.
+
+
+@item (nnchoke-request-expire-articles ARTICLES &optional GROUP SERVER FORCE)
+
+This function should run the expiry process on all articles in the
+@var{articles} range (which is currently a simple list of article
+numbers.) It is left up to the backend to decide how old articles
+should be before they are removed by this function. If @var{force} is
+non-@code{nil}, all @var{articles} should be deleted, no matter how new
+they are.
+
+This function should return a list of articles that it did not/was not
+able to delete.
+
+There should be no result data returned.
+
+
+@item (nnchoke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM
+&optional LAST)
+
+This function should move @var{article} (which is a number) from
+@var{group} by calling @var{accept-form}.
+
+This function should ready the article in question for moving by
+removing any header lines it has added to the article, and generally
+should ``tidy up'' the article. Then it should @code{eval}
+@var{accept-form} in the buffer where the ``tidy'' article is. This
+will do the actual copying. If this @code{eval} returns a
+non-@code{nil} value, the article should be removed.
+
+If @var{last} is @code{nil}, that means that there is a high likelihood
+that there will be more requests issued shortly, so that allows some
+optimizations.
+
+The function should return a cons where the @code{car} is the group name and
+the @code{cdr} is the article number that the article was entered as.
+
+There should be no data returned.
+
+
+@item (nnchoke-request-accept-article GROUP &optional SERVER LAST)
+
+This function takes the current buffer and inserts it into @var{group}.
+If @var{last} in @code{nil}, that means that there will be more calls to
+this function in short order.
+
+The function should return a cons where the @code{car} is the group name and
+the @code{cdr} is the article number that the article was entered as.
+
+There should be no data returned.
+
+
+@item (nnchoke-request-replace-article ARTICLE GROUP BUFFER)
+
+This function should remove @var{article} (which is a number) from
+@var{group} and insert @var{buffer} there instead.
+
+There should be no data returned.
+
+
+@item (nnchoke-request-delete-group GROUP FORCE &optional SERVER)
+
+This function should delete @var{group}. If @var{force}, it should
+really delete all the articles in the group, and then delete the group
+itself. (If there is such a thing as ``the group itself''.)
+
+There should be no data returned.
+
+
+@item (nnchoke-request-rename-group GROUP NEW-NAME &optional SERVER)
+
+This function should rename @var{group} into @var{new-name}. All
+articles in @var{group} should move to @var{new-name}.
+
+There should be no data returned.
+
+@end table
+
+
+@node Error Messaging
+@subsubsection Error Messaging
+
+@findex nnheader-report
+@findex nnheader-get-report
+The backends should use the function @code{nnheader-report} to report
+error conditions---they should not raise errors when they aren't able to
+perform a request. The first argument to this function is the backend
+symbol, and the rest are interpreted as arguments to @code{format} if
+there are multiple of them, or just a string if there is one of them.
+This function must always returns @code{nil}.
+
+@lisp
+(nnheader-report 'nnchoke "You did something totally bogus")
+
+(nnheader-report 'nnchoke "Could not request group %s" group)
+@end lisp
+
+Gnus, in turn, will call @code{nnheader-get-report} when it gets a
+@code{nil} back from a server, and this function returns the most
+recently reported message for the backend in question. This function
+takes one argument---the server symbol.
+
+Internally, these functions access @var{backend}@code{-status-string},
+so the @code{nnchoke} backend will have its error message stored in
+@code{nnchoke-status-string}.
+
+
+@node Writing New Backends
+@subsubsection Writing New Backends
+
+Many backends are quite similar. @code{nnml} is just like
+@code{nnspool}, but it allows you to edit the articles on the server.
+@code{nnmh} is just like @code{nnml}, but it doesn't use an active file,
+and it doesn't maintain overview databases. @code{nndir} is just like
+@code{nnml}, but it has no concept of ``groups'', and it doesn't allow
+editing articles.
+
+It would make sense if it were possible to ``inherit'' functions from
+backends when writing new backends. And, indeed, you can do that if you
+want to. (You don't have to if you don't want to, of course.)
+
+All the backends declare their public variables and functions by using a
+package called @code{nnoo}.
+
+To inherit functions from other backends (and allow other backends to
+inherit functions from the current backend), you should use the
+following macros:
+
+@table @code
+
+@item nnoo-declare
+This macro declares the first parameter to be a child of the subsequent
+parameters. For instance:
+
+@lisp
+(nnoo-declare nndir
+ nnml nnmh)
+@end lisp
+
+@code{nndir} has declared here that it intends to inherit functions from
+both @code{nnml} and @code{nnmh}.
+
+@item defvoo
+This macro is equivalent to @code{defvar}, but registers the variable as
+a public server variable. Most state-oriented variables should be
+declared with @code{defvoo} instead of @code{defvar}.
+
+In addition to the normal @code{defvar} parameters, it takes a list of
+variables in the parent backends to map the variable to when executing
+a function in those backends.
+
+@lisp
+(defvoo nndir-directory nil
+ "Where nndir will look for groups."
+ nnml-current-directory nnmh-current-directory)
+@end lisp
+
+This means that @code{nnml-current-directory} will be set to
+@code{nndir-directory} when an @code{nnml} function is called on behalf
+of @code{nndir}. (The same with @code{nnmh}.)
+
+@item nnoo-define-basics
+This macro defines some common functions that almost all backends should
+have.
+
+@example
+(nnoo-define-basics nndir)
+@end example
+
+@item deffoo
+This macro is just like @code{defun} and takes the same parameters. In
+addition to doing the normal @code{defun} things, it registers the
+function as being public so that other backends can inherit it.
+
+@item nnoo-map-functions
+This macro allows mapping of functions from the current backend to
+functions from the parent backends.
+
+@example
+(nnoo-map-functions nndir
+ (nnml-retrieve-headers 0 nndir-current-group 0 0)
+ (nnmh-request-article 0 nndir-current-group 0 0))
+@end example
+
+This means that when @code{nndir-retrieve-headers} is called, the first,
+third, and fourth parameters will be passed on to
+@code{nnml-retrieve-headers}, while the second parameter is set to the
+value of @code{nndir-current-group}.
+
+@item nnoo-import
+This macro allows importing functions from backends. It should be the
+last thing in the source file, since it will only define functions that
+haven't already been defined.
+
+@example
+(nnoo-import nndir
+ (nnmh
+ nnmh-request-list
+ nnmh-request-newgroups)
+ (nnml))
+@end example
+
+This means that calls to @code{nndir-request-list} should just be passed
+on to @code{nnmh-request-list}, while all public functions from
+@code{nnml} that haven't been defined in @code{nndir} yet should be
+defined now.
+
+@end table
+
+Below is a slightly shortened version of the @code{nndir} backend.
+
+@lisp
+;;; nndir.el --- single directory newsgroup access for Gnus
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmh)
+(require 'nnml)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nndir
+ nnml nnmh)
+
+(defvoo nndir-directory nil
+ "Where nndir will look for groups."
+ nnml-current-directory nnmh-current-directory)
+
+(defvoo nndir-nov-is-evil nil
+ "*Non-nil means that nndir will never retrieve NOV headers."
+ nnml-nov-is-evil)
+
+(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group)
+(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory)
+(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail)
+
+(defvoo nndir-status-string "" nil nnmh-status-string)
+(defconst nndir-version "nndir 1.0")
+
+;;; Interface functions.
+
+(nnoo-define-basics nndir)
+
+(deffoo nndir-open-server (server &optional defs)
+ (setq nndir-directory
+ (or (cadr (assq 'nndir-directory defs))
+ server))
+ (unless (assq 'nndir-directory defs)
+ (push `(nndir-directory ,server) defs))
+ (push `(nndir-current-group
+ ,(file-name-nondirectory (directory-file-name nndir-directory)))
+ defs)
+ (push `(nndir-top-directory
+ ,(file-name-directory (directory-file-name nndir-directory)))
+ defs)
+ (nnoo-change-server 'nndir server defs))
+
+(nnoo-map-functions nndir
+ (nnml-retrieve-headers 0 nndir-current-group 0 0)
+ (nnmh-request-article 0 nndir-current-group 0 0)
+ (nnmh-request-group nndir-current-group 0 0)
+ (nnmh-close-group nndir-current-group 0))
+
+(nnoo-import nndir
+ (nnmh
+ nnmh-status-message
+ nnmh-request-list
+ nnmh-request-newgroups))
+
+(provide 'nndir)
+@end lisp
+
+
+@node Hooking New Backends Into Gnus
+@subsubsection Hooking New Backends Into Gnus
+
+@vindex gnus-valid-select-methods
+Having Gnus start using your new backend is rather easy---you just
+declare it with the @code{gnus-declare-backend} functions. This will
+enter the backend into the @code{gnus-valid-select-methods} variable.
+
+@code{gnus-declare-backend} takes two parameters---the backend name and
+an arbitrary number of @dfn{abilities}.
+
+Here's an example:
+
+@lisp
+(gnus-declare-backend "nnchoke" 'mail 'respool 'address)
+@end lisp
+
+The abilities can be:
+
+@table @code
+@item mail
+This is a mailish backend---followups should (probably) go via mail.
+@item post
+This is a newsish backend---followups should (probably) go via news.
+@item post-mail
+This backend supports both mail and news.
+@item none
+This is neither a post nor mail backend---it's something completely
+different.
+@item respool
+It supports respooling---or rather, it is able to modify its source
+articles and groups.
+@item address
+The name of the server should be in the virtual server name. This is
+true for almost all backends.
+@item prompt-address
+The user should be prompted for an address when doing commands like
+@kbd{B} in the group buffer. This is true for backends like
+@code{nntp}, but not @code{nnmbox}, for instance.
+@end table
+
+
+@node Mail-like Backends
+@subsubsection Mail-like Backends
+
+One of the things that separate the mail backends from the rest of the
+backends is the heavy dependence by the mail backends on common
+functions in @file{nnmail.el}. For instance, here's the definition of
+@code{nnml-request-scan}:
+
+@lisp
+(deffoo nnml-request-scan (&optional group server)
+ (setq nnml-article-file-alist nil)
+ (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
+@end lisp
+
+It simply calls @code{nnmail-get-new-mail} with a few parameters,
+and @code{nnmail} takes care of all the moving and splitting of the
+mail.
+
+This function takes four parameters.
+
+@table @var
+@item method
+This should be a symbol to designate which backend is responsible for
+the call.
+
+@item exit-function
+This function should be called after the splitting has been performed.
+
+@item temp-directory
+Where the temporary files should be stored.
+
+@item group
+This optional argument should be a group name if the splitting is to be
+performed for one group only.
+@end table
+
+@code{nnmail-get-new-mail} will call @var{backend}@code{-save-mail} to
+save each article. @var{backend}@code{-active-number} will be called to
+find the article number assigned to this article.
+
+The function also uses the following variables:
+@var{backend}@code{-get-new-mail} (to see whether to get new mail for
+this backend); and @var{backend}@code{-group-alist} and
+@var{backend}@code{-active-file} to generate the new active file.
+@var{backend}@code{-group-alist} should be a group-active alist, like
+this:
+
+@example
+(("a-group" (1 . 10))
+ ("some-group" (34 . 39)))
+@end example
+
+
+@node Score File Syntax
+@subsection Score File Syntax
+
+Score files are meant to be easily parsable, but yet extremely
+mallable. It was decided that something that had the same read syntax
+as an Emacs Lisp list would fit that spec.
+
+Here's a typical score file:
+
+@lisp
+(("summary"
+ ("win95" -10000 nil s)
+ ("Gnus"))
+ ("from"
+ ("Lars" -1000))
+ (mark -100))
+@end lisp
+
+BNF definition of a score file:
+
+@example
+score-file = "" / "(" *element ")"
+element = rule / atom
+rule = string-rule / number-rule / date-rule
+string-rule = "(" quote string-header quote space *string-match ")"
+number-rule = "(" quote number-header quote space *number-match ")"
+date-rule = "(" quote date-header quote space *date-match ")"
+quote = <ascii 34>
+string-header = "subject" / "from" / "references" / "message-id" /
+ "xref" / "body" / "head" / "all" / "followup"
+number-header = "lines" / "chars"
+date-header = "date"
+string-match = "(" quote <string> quote [ "" / [ space score [ "" /
+ space date [ "" / [ space string-match-t ] ] ] ] ] ")"
+score = "nil" / <integer>
+date = "nil" / <natural number>
+string-match-t = "nil" / "s" / "substring" / "S" / "Substring" /
+ "r" / "regex" / "R" / "Regex" /
+ "e" / "exact" / "E" / "Exact" /
+ "f" / "fuzzy" / "F" / "Fuzzy"
+number-match = "(" <integer> [ "" / [ space score [ "" /
+ space date [ "" / [ space number-match-t ] ] ] ] ] ")"
+number-match-t = "nil" / "=" / "<" / ">" / ">=" / "<="
+date-match = "(" quote <string> quote [ "" / [ space score [ "" /
+ space date [ "" / [ space date-match-t ] ] ] ] ")"
+date-match-t = "nil" / "at" / "before" / "after"
+atom = "(" [ required-atom / optional-atom ] ")"
+required-atom = mark / expunge / mark-and-expunge / files /
+ exclude-files / read-only / touched
+optional-atom = adapt / local / eval
+mark = "mark" space nil-or-number
+nil-or-number = "nil" / <integer>
+expunge = "expunge" space nil-or-number
+mark-and-expunge = "mark-and-expunge" space nil-or-number
+files = "files" *[ space <string> ]
+exclude-files = "exclude-files" *[ space <string> ]
+read-only = "read-only" [ space "nil" / space "t" ]
+adapt = "adapt" [ space "ignore" / space "t" / space adapt-rule ]
+adapt-rule = "(" *[ <string> *[ "(" <string> <integer> ")" ] ")"
+local = "local" *[ space "(" <string> space <form> ")" ]
+eval = "eval" space <form>
+space = *[ " " / <TAB> / <NEWLINE> ]
+@end example
+
+Any unrecognized elements in a score file should be ignored, but not
+discarded.
+
+As you can see, white space is needed, but the type and amount of white
+space is irrelevant. This means that formatting of the score file is
+left up to the programmer---if it's simpler to just spew it all out on
+one looong line, then that's ok.
+
+The meaning of the various atoms are explained elsewhere in this
+manual (@pxref{Score File Format}).
+
+
+@node Headers
+@subsection Headers
+
+Internally Gnus uses a format for storing article headers that
+corresponds to the @sc{nov} format in a mysterious fashion. One could
+almost suspect that the author looked at the @sc{nov} specification and
+just shamelessly @emph{stole} the entire thing, and one would be right.
+
+@dfn{Header} is a severely overloaded term. ``Header'' is used in
+RFC1036 to talk about lines in the head of an article (e.g.,
+@code{From}). It is used by many people as a synonym for
+``head''---``the header and the body''. (That should be avoided, in my
+opinion.) And Gnus uses a format internally that it calls ``header'',
+which is what I'm talking about here. This is a 9-element vector,
+basically, with each header (ouch) having one slot.
+
+These slots are, in order: @code{number}, @code{subject}, @code{from},
+@code{date}, @code{id}, @code{references}, @code{chars}, @code{lines},
+@code{xref}. There are macros for accessing and setting these
+slots---they all have predictable names beginning with
+@code{mail-header-} and @code{mail-header-set-}, respectively.
+
+The @code{xref} slot is really a @code{misc} slot. Any extra info will
+be put in there.
+
+
+@node Ranges
+@subsection Ranges
+
+@sc{gnus} introduced a concept that I found so useful that I've started
+using it a lot and have elaborated on it greatly.
+
+The question is simple: If you have a large amount of objects that are
+identified by numbers (say, articles, to take a @emph{wild} example)
+that you want to qualify as being ``included'', a normal sequence isn't
+very useful. (A 200,000 length sequence is a bit long-winded.)
+
+The solution is as simple as the question: You just collapse the
+sequence.
+
+@example
+(1 2 3 4 5 6 10 11 12)
+@end example
+
+is transformed into
+
+@example
+((1 . 6) (10 . 12))
+@end example
+
+To avoid having those nasty @samp{(13 . 13)} elements to denote a
+lonesome object, a @samp{13} is a valid element:
+
+@example
+((1 . 6) 7 (10 . 12))
+@end example
+
+This means that comparing two ranges to find out whether they are equal
+is slightly tricky:
+
+@example
+((1 . 5) 7 8 (10 . 12))
+@end example
+
+and
+
+@example
+((1 . 5) (7 . 8) (10 . 12))
+@end example
+
+are equal. In fact, any non-descending list is a range:
+
+@example
+(1 2 3 4 5)
+@end example
+
+is a perfectly valid range, although a pretty long-winded one. This is
+also valid:
+
+@example
+(1 . 5)
+@end example
+
+and is equal to the previous range.
+
+Here's a BNF definition of ranges. Of course, one must remember the
+semantic requirement that the numbers are non-descending. (Any number
+of repetition of the same number is allowed, but apt to disappear in
+range handling.)
+
+@example
+range = simple-range / normal-range
+simple-range = "(" number " . " number ")"
+normal-range = "(" start-contents ")"
+contents = "" / simple-range *[ " " contents ] /
+ number *[ " " contents ]
+@end example
+
+Gnus currently uses ranges to keep track of read articles and article
+marks. I plan on implementing a number of range operators in C if The
+Powers That Be are willing to let me. (I haven't asked yet, because I
+need to do some more thinking on what operators I need to make life
+totally range-based without ever having to convert back to normal
+sequences.)
+
+
+@node Group Info
+@subsection Group Info
+
+Gnus stores all permanent info on groups in a @dfn{group info} list.
+This list is from three to six elements (or more) long and exhaustively
+describes the group.
+
+Here are two example group infos; one is a very simple group while the
+second is a more complex one:
+
+@example
+("no.group" 5 (1 . 54324))
+
+("nnml:my.mail" 3 ((1 . 5) 9 (20 . 55))
+ ((tick (15 . 19)) (replied 3 6 (19 . 3)))
+ (nnml "")
+ (auto-expire (to-address "ding@@gnus.org")))
+@end example
+
+The first element is the @dfn{group name}---as Gnus knows the group,
+anyway. The second element is the @dfn{subscription level}, which
+normally is a small integer. The third element is a list of ranges of
+read articles. The fourth element is a list of lists of article marks
+of various kinds. The fifth element is the select method (or virtual
+server, if you like). The sixth element is a list of @dfn{group
+parameters}, which is what this section is about.
+
+Any of the last three elements may be missing if they are not required.
+In fact, the vast majority of groups will normally only have the first
+three elements, which saves quite a lot of cons cells.
+
+Here's a BNF definition of the group info format:
+
+@example
+info = "(" group space level space read
+ [ "" / [ space marks-list [ "" / [ space method [ "" /
+ space parameters ] ] ] ] ] ")"
+group = quote <string> quote
+level = <integer in the range of 1 to inf>
+read = range
+marks-lists = nil / "(" *marks ")"
+marks = "(" <string> range ")"
+method = "(" <string> *elisp-forms ")"
+parameters = "(" *elisp-forms ")"
+@end example
+
+Actually that @samp{marks} rule is a fib. A @samp{marks} is a
+@samp{<string>} consed on to a @samp{range}, but that's a bitch to say
+in pseudo-BNF.
+
+If you have a Gnus info and want to access the elements, Gnus offers a
+series of macros for getting/setting these elements.
+
+@table @code
+@item gnus-info-group
+@itemx gnus-info-set-group
+@findex gnus-info-group
+@findex gnus-info-set-group
+Get/set the group name.
+
+@item gnus-info-rank
+@itemx gnus-info-set-rank
+@findex gnus-info-rank
+@findex gnus-info-set-rank
+Get/set the group rank.
+
+@item gnus-info-level
+@itemx gnus-info-set-level
+@findex gnus-info-level
+@findex gnus-info-set-level
+Get/set the group level.
+
+@item gnus-info-score
+@itemx gnus-info-set-score
+@findex gnus-info-score
+@findex gnus-info-set-score
+Get/set the group score.
+
+@item gnus-info-read
+@itemx gnus-info-set-read
+@findex gnus-info-read
+@findex gnus-info-set-read
+Get/set the ranges of read articles.
+
+@item gnus-info-marks
+@itemx gnus-info-set-marks
+@findex gnus-info-marks
+@findex gnus-info-set-marks
+Get/set the lists of ranges of marked articles.
+
+@item gnus-info-method
+@itemx gnus-info-set-method
+@findex gnus-info-method
+@findex gnus-info-set-method
+Get/set the group select method.
+
+@item gnus-info-params
+@itemx gnus-info-set-params
+@findex gnus-info-params
+@findex gnus-info-set-params
+Get/set the group parameters.
+@end table
+
+All the getter functions take one parameter---the info list. The setter
+functions take two parameters---the info list and the new value.
+
+The last three elements in the group info aren't mandatory, so it may be
+necessary to extend the group info before setting the element. If this
+is necessary, you can just pass on a non-@code{nil} third parameter to
+the three final setter functions to have this happen automatically.
+
+
+@node Extended Interactive
+@subsection Extended Interactive
+@cindex interactive
+@findex gnus-interactive
+
+Gnus extends the standard Emacs @code{interactive} specification
+slightly to allow easy use of the symbolic prefix (@pxref{Symbolic
+Prefixes}). Here's an example of how this is used:
+
+@lisp
+(defun gnus-summary-increase-score (&optional score symp)
+ (interactive (gnus-interactive "P\ny"))
+ ...
+ )
+@end lisp
+
+The best thing to do would have been to implement
+@code{gnus-interactive} as a macro which would have returned an
+@code{interactive} form, but this isn't possible since Emacs checks
+whether a function is interactive or not by simply doing an @code{assq}
+on the lambda form. So, instead we have @code{gnus-interactive}
+function that takes a string and returns values that are usable to
+@code{interactive}.
+
+This function accepts (almost) all normal @code{interactive} specs, but
+adds a few more.
+
+@table @samp
+@item y
+@vindex gnus-current-prefix-symbol
+The current symbolic prefix---the @code{gnus-current-prefix-symbol}
+variable.
+
+@item Y
+@vindex gnus-current-prefix-symbols
+A list of the current symbolic prefixes---the
+@code{gnus-current-prefix-symbol} variable.
+
+@item A
+The current article number---the @code{gnus-summary-article-number}
+function.
+
+@item H
+The current article header---the @code{gnus-summary-article-header}
+function.
+
+@item g
+The current group name---the @code{gnus-group-group-name}
+function.
+
+@end table
+
+
+@node Emacs/XEmacs Code
+@subsection Emacs/XEmacs Code
+@cindex XEmacs
+@cindex Emacsen
+
+While Gnus runs under Emacs, XEmacs and Mule, I decided that one of the
+platforms must be the primary one. I chose Emacs. Not because I don't
+like XEmacs or Mule, but because it comes first alphabetically.
+
+This means that Gnus will byte-compile under Emacs with nary a warning,
+while XEmacs will pump out gigabytes of warnings while byte-compiling.
+As I use byte-compilation warnings to help me root out trivial errors in
+Gnus, that's very useful.
+
+I've also consistently used Emacs function interfaces, but have used
+Gnusey aliases for the functions. To take an example: Emacs defines a
+@code{run-at-time} function while XEmacs defines a @code{start-itimer}
+function. I then define a function called @code{gnus-run-at-time} that
+takes the same parameters as the Emacs @code{run-at-time}. When running
+Gnus under Emacs, the former function is just an alias for the latter.
+However, when running under XEmacs, the former is an alias for the
+following function:
+
+@lisp
+(defun gnus-xmas-run-at-time (time repeat function &rest args)
+ (start-itimer
+ "gnus-run-at-time"
+ `(lambda ()
+ (,function ,@@args))
+ time repeat))
+@end lisp
+
+This sort of thing has been done for bunches of functions. Gnus does
+not redefine any native Emacs functions while running under XEmacs---it
+does this @code{defalias} thing with Gnus equivalents instead. Cleaner
+all over.
+
+In the cases where the XEmacs function interface was obviously cleaner,
+I used it instead. For example @code{gnus-region-active-p} is an alias
+for @code{region-active-p} in XEmacs, whereas in Emacs it is a function.
+
+Of course, I could have chosen XEmacs as my native platform and done
+mapping functions the other way around. But I didn't. The performance
+hit these indirections impose on Gnus under XEmacs should be slight.
+
+
+@node Various File Formats
+@subsection Various File Formats
+
+@menu
+* Active File Format:: Information on articles and groups available.
+* Newsgroups File Format:: Group descriptions.
+@end menu
+
+
+@node Active File Format
+@subsubsection Active File Format
+
+The active file lists all groups available on the server in
+question. It also lists the highest and lowest current article numbers
+in each group.
+
+Here's an excerpt from a typical active file:
+
+@example
+soc.motss 296030 293865 y
+alt.binaries.pictures.fractals 3922 3913 n
+comp.sources.unix 1605 1593 m
+comp.binaries.ibm.pc 5097 5089 y
+no.general 1000 900 y
+@end example
+
+Here's a pseudo-BNF definition of this file:
+
+@example
+active = *group-line
+group-line = group space high-number space low-number space flag <NEWLINE>
+group = <non-white-space string>
+space = " "
+high-number = <non-negative integer>
+low-number = <positive integer>
+flag = "y" / "n" / "m" / "j" / "x" / "=" group
+@end example
+
+
+@node Newsgroups File Format
+@subsubsection Newsgroups File Format
+
+The newsgroups file lists groups along with their descriptions. Not all
+groups on the server have to be listed, and not all groups in the file
+have to exist on the server. The file is meant purely as information to
+the user.
+
+The format is quite simple; a group name, a tab, and the description.
+Here's the definition:
+
+@example
+newsgroups = *line
+line = group tab description <NEWLINE>
+group = <non-white-space string>
+tab = <TAB>
+description = <string>
+@end example
+
+
+@node Emacs for Heathens
+@section Emacs for Heathens
+
+Believe it or not, but some people who use Gnus haven't really used
+Emacs much before they embarked on their journey on the Gnus Love Boat.
+If you are one of those unfortunates whom ``@kbd{M-C-a}'', ``kill the
+region'', and ``set @code{gnus-flargblossen} to an alist where the key
+is a regexp that is used for matching on the group name'' are magical
+phrases with little or no meaning, then this appendix is for you. If
+you are already familiar with Emacs, just ignore this and go fondle your
+cat instead.
+
+@menu
+* Keystrokes:: Entering text and executing commands.
+* Emacs Lisp:: The built-in Emacs programming language.
+@end menu
+
+
+@node Keystrokes
+@subsection Keystrokes
+
+@itemize @bullet
+@item
+Q: What is an experienced Emacs user?
+
+@item
+A: A person who wishes that the terminal had pedals.
+@end itemize
+
+Yes, when you use Emacs, you are apt to use the control key, the shift
+key and the meta key a lot. This is very annoying to some people
+(notably @code{vi}le users), and the rest of us just love the hell out
+of it. Just give up and submit. Emacs really does stand for
+``Escape-Meta-Alt-Control-Shift'', and not ``Editing Macros'', as you
+may have heard from other disreputable sources (like the Emacs author).
+
+The shift keys are normally located near your pinky fingers, and are
+normally used to get capital letters and stuff. You probably use it all
+the time. The control key is normally marked ``CTRL'' or something like
+that. The meta key is, funnily enough, never marked as such on any
+keyboard. The one I'm currently at has a key that's marked ``Alt'',
+which is the meta key on this keyboard. It's usually located somewhere
+to the left hand side of the keyboard, usually on the bottom row.
+
+Now, us Emacs people don't say ``press the meta-control-m key'',
+because that's just too inconvenient. We say ``press the @kbd{M-C-m}
+key''. @kbd{M-} is the prefix that means ``meta'' and ``C-'' is the
+prefix that means ``control''. So ``press @kbd{C-k}'' means ``press
+down the control key, and hold it down while you press @kbd{k}''.
+``Press @kbd{M-C-k}'' means ``press down and hold down the meta key and
+the control key and then press @kbd{k}''. Simple, ay?
+
+This is somewhat complicated by the fact that not all keyboards have a
+meta key. In that case you can use the ``escape'' key. Then @kbd{M-k}
+means ``press escape, release escape, press @kbd{k}''. That's much more
+work than if you have a meta key, so if that's the case, I respectfully
+suggest you get a real keyboard with a meta key. You can't live without
+it.
+
+
+
+@node Emacs Lisp
+@subsection Emacs Lisp
+
+Emacs is the King of Editors because it's really a Lisp interpreter.
+Each and every key you tap runs some Emacs Lisp code snippet, and since
+Emacs Lisp is an interpreted language, that means that you can configure
+any key to run any arbitrary code. You just, like, do it.
+
+Gnus is written in Emacs Lisp, and is run as a bunch of interpreted
+functions. (These are byte-compiled for speed, but it's still
+interpreted.) If you decide that you don't like the way Gnus does
+certain things, it's trivial to have it do something a different way.
+(Well, at least if you know how to write Lisp code.) However, that's
+beyond the scope of this manual, so we are simply going to talk about
+some common constructs that you normally use in your @file{.emacs} file
+to customize Gnus.
+
+If you want to set the variable @code{gnus-florgbnize} to four (4), you
+write the following:
+
+@lisp
+(setq gnus-florgbnize 4)
+@end lisp
+
+This function (really ``special form'') @code{setq} is the one that can
+set a variable to some value. This is really all you need to know. Now
+you can go and fill your @code{.emacs} file with lots of these to change
+how Gnus works.
+
+If you have put that thing in your @code{.emacs} file, it will be read
+and @code{eval}ed (which is lisp-ese for ``run'') the next time you
+start Emacs. If you want to change the variable right away, simply say
+@kbd{C-x C-e} after the closing parenthesis. That will @code{eval} the
+previous ``form'', which is a simple @code{setq} statement here.
+
+Go ahead---just try it, if you're located at your Emacs. After you
+@kbd{C-x C-e}, you will see @samp{4} appear in the echo area, which
+is the return value of the form you @code{eval}ed.
+
+Some pitfalls:
+
+If the manual says ``set @code{gnus-read-active-file} to @code{some}'',
+that means:
+
+@lisp
+(setq gnus-read-active-file 'some)
+@end lisp
+
+On the other hand, if the manual says ``set @code{gnus-nntp-server} to
+@samp{nntp.ifi.uio.no}'', that means:
+
+@lisp
+(setq gnus-nntp-server "nntp.ifi.uio.no")
+@end lisp
+
+So be careful not to mix up strings (the latter) with symbols (the
+former). The manual is unambiguous, but it can be confusing.
+
+
+@include gnus-faq.texi
+
+@node Index
+@chapter Index
+@printindex cp
+
+@node Key Index
+@chapter Key Index
+@printindex ky
+
+@summarycontents
+@contents
+@bye
+
+@iftex
+@iflatex
+\end{document}
+@end iflatex
+@end iftex
+
+@c End:
+
--- /dev/null
+%!PS-Adobe-2.0 EPSF-1.2
+%%Creator: Adobe Illustrator 88(TM) format generated by CorelTRACE Version 2.0C
+%%Title: /home/menja/c/larsi/gnus.eps
+%%BoundingBox: 0 0 924.5 907.2
+%%CreationDate: Tue Feb 20 01:51:37 1996
+%%DocumentFonts:
+%%ColorUsage: B & W
+%%TileBox: 0 0 924.5 907.2
+%%EndComments
+%%BeginProcSet:Adobe_Illustrator_1.1 0 0
+% Copyright 1992 Corel Corporation.
+
+% All rights reserved.
+.15 .15 scale
+
+/wPSMDict 150 dict def
+wPSMDict begin
+/bd {bind def} bind def
+/ld {load def} bd
+/xd {exch def} bd
+/_ null def
+/$c 0 def
+/$m 0 def
+/$y 0 def
+/$k 0 def
+/$t 1 def
+/$n _ def
+/$o 0 def
+/$C 0 def
+/$M 0 def
+/$Y 0 def
+/$K 0 def
+/$T 1 def
+/$N _ def
+/$O 0 def
+/$h false def
+/$al 0 def
+/$tr 0 def
+/$le 0 def
+/$lx 0 def
+/$ly 0 def
+/$ctm matrix currentmatrix def
+/@cp /closepath ld
+/@gs /gsave ld
+/@gr /grestore ld
+/@MN {2 copy le{pop}{exch pop}ifelse}bd
+/setcmykcolor where {pop}{/setcmykcolor{4 1 roll
+3 {3 index add 1 @MN 1 exch sub 3 1 roll} repeat
+setrgbcolor
+pop}bd}ifelse
+/@tc{dup 1 ge{pop}{4 {dup
+6 -1 roll
+mul
+exch}repeat
+pop}ifelse}bd
+/@scc{$c $m $y $k $t @tc setcmykcolor true}bd
+/@SCC{$C $M $Y $K $T @tc setcmykcolor true}bd
+/@sm{/$ctm $ctm currentmatrix def}bd
+/x {/$t xd /$n xd
+/$k xd /$y xd /$m xd /$c xd}bd
+/X {/$T xd /$N xd
+/$K xd /$Y xd /$M xd /$C xd}bd
+/g {1 exch sub 0 0 0
+4 -1 roll
+_ 1 x}bd
+/G {1 exch sub 0 0 0
+4 -1 roll
+_ 1 X}bd
+/k {_ 1 x}bd
+/K {_ 1 X}bd
+/d /setdash ld
+/i {dup 0 ne {setflat} {pop} ifelse}bd
+/j /setlinejoin ld
+/J /setlinecap ld
+/M /setmiterlimit ld
+/w /setlinewidth ld
+/O {/$o xd}bd
+/R {/$O xd}bd
+/c /curveto ld
+/C /c ld
+/l /lineto ld
+/L /l ld
+/m /moveto ld
+/n /newpath ld
+/N /newpath ld
+/F {@scc{eofill}if n} bd
+/f {@cp F}bd
+/S {@SCC{stroke}if n} bd
+/s {@cp
+S}bd
+/B {@gs F @gr
+S}bd
+/b {@cp B }bd
+/u {}bd
+/U {}bd
+%%EndProlog
+%%BeginSetup
+%%EndSetup
+1 i
+2 J
+0 j
+4 M
+[]0 d
+
+%%Note: traced as Normal_Outline
+0 g
+259.2 78.2 m
+327.3 178.5 L
+327.8 179.0 328.3 180.0 329.7 180.4 C
+373.4 241.9 L
+388.8 263.5 L
+389.2 264.0 390.7 264.4 391.6 265.4 C
+413.7 298.0 453.6 351.8 468.0 404.6 C
+467.5 405.6 467.5 407.0 467.5 407.0 C
+442.0 367.6 411.3 319.2 379.2 279.3 C
+372.0 267.3 366.7 265.9 361.9 254.8 C
+333.1 216.0 L
+323.5 207.3 311.0 185.2 302.8 175.6 C
+298.0 165.6 293.2 164.1 288.9 154.0 C
+282.2 147.8 282.2 139.6 276.4 132.4 C
+258.2 77.7 L
+258.2 77.7 259.2 78.2 259.2 78.2 C
+f
+0 g
+470.8 211.6 m
+470.8 211.6 472.3 212.1 472.3 212.1 C
+518.8 305.2 L
+531.3 317.2 L
+537.6 314.8 539.0 300.9 548.6 301.9 C
+555.8 301.9 554.8 302.8 561.6 306.2 C
+595.2 357.1 L
+595.6 358.0 597.6 358.5 598.5 360.0 C
+615.8 398.4 650.8 450.7 657.6 483.8 C
+658.0 486.2 658.0 488.1 658.0 489.6 C
+654.2 489.1 656.1 485.2 650.4 479.5 C
+634.5 446.8 611.5 402.2 592.8 377.2 C
+588.0 370.0 581.7 365.7 577.4 358.5 C
+570.2 355.6 568.3 351.3 560.1 356.6 C
+554.8 360.0 553.9 364.8 550.0 370.0 C
+548.1 371.5 550.0 370.5 547.2 371.0 C
+541.4 365.2 L
+511.2 319.6 484.3 276.0 471.8 220.3 C
+470.8 215.5 471.3 215.5 469.4 212.1 C
+469.4 212.1 470.8 211.6 470.8 211.6 C
+f
+0 g
+731.0 292.8 m
+756.0 351.3 751.6 407.0 771.3 468.0 C
+783.3 520.8 809.7 582.2 822.2 635.0 C
+829.4 684.4 855.8 732.0 825.1 789.1 C
+811.6 797.7 799.6 805.4 784.8 802.0 C
+757.9 792.0 732.9 743.0 726.2 712.8 C
+727.6 708.4 727.2 707.0 730.0 704.6 C
+731.0 704.1 732.9 704.1 734.4 704.6 C
+737.2 709.9 L
+754.0 747.3 L
+758.8 755.0 771.8 754.0 781.9 751.2 C
+788.1 748.3 791.5 745.9 797.7 744.0 C
+831.8 680.1 800.6 611.0 784.3 542.8 C
+765.6 478.5 748.3 431.5 739.2 370.5 C
+733.9 347.5 729.1 318.7 730.0 292.8 C
+730.0 292.8 731.0 292.8 731.0 292.8 C
+f
+0 g
+434.4 462.7 m
+460.3 496.8 462.2 532.8 458.4 575.5 C
+456.4 588.0 451.2 599.0 445.4 609.1 C
+435.3 620.1 435.3 622.5 421.9 630.7 C
+411.8 619.6 398.4 604.8 391.6 586.0 C
+393.6 581.7 396.4 584.1 401.7 577.9 C
+403.2 577.4 404.6 576.9 404.6 576.9 C
+407.0 574.5 406.0 573.6 410.4 571.2 C
+414.2 564.0 418.5 558.2 424.3 545.7 C
+437.2 526.5 428.1 489.6 433.9 462.2 C
+433.9 462.2 434.4 462.7 434.4 462.7 C
+f
+0 g
+226.0 482.4 m
+281.7 485.7 311.0 531.3 357.1 565.9 C
+362.8 572.1 364.8 574.0 368.6 580.3 C
+368.6 581.7 369.1 582.7 369.6 584.6 C
+370.0 585.6 371.5 587.0 372.9 588.0 C
+381.6 606.2 L
+377.2 605.2 374.8 602.8 371.0 597.6 C
+346.0 576.4 316.8 552.0 289.9 536.1 C
+288.9 535.2 288.0 534.2 288.0 534.2 C
+273.6 528.0 263.5 527.5 247.6 530.8 C
+242.4 535.2 239.0 536.1 238.0 544.3 C
+239.5 572.1 266.8 600.0 281.2 624.9 C
+293.7 637.9 300.4 650.4 311.5 668.1 C
+312.0 669.1 313.9 669.6 314.8 671.0 C
+319.6 679.6 L
+319.6 680.1 319.6 681.6 319.2 682.0 C
+285.6 649.4 258.7 601.4 229.9 555.8 C
+216.4 529.9 205.4 511.2 210.2 491.0 C
+212.6 483.8 218.8 484.8 226.0 482.4 C
+f
+0 g
+624.9 600.4 m
+645.1 606.2 L
+676.3 622.5 694.5 658.0 710.8 698.4 C
+710.4 704.1 711.3 704.6 712.3 709.4 C
+696.9 685.9 693.6 667.6 662.4 653.7 C
+654.7 651.3 649.4 650.4 639.3 650.8 C
+633.1 654.2 625.4 659.0 621.6 670.5 C
+597.6 620.6 L
+600.9 612.4 604.3 607.2 613.4 603.8 C
+617.2 603.3 621.1 601.4 624.9 600.4 C
+f
+0 g
+528.4 619.2 m
+548.6 617.2 564.9 629.2 578.8 645.6 C
+584.1 651.8 586.5 662.8 591.8 671.0 C
+593.2 681.6 603.8 690.2 601.9 704.1 C
+598.5 705.1 599.0 698.8 594.7 694.0 C
+581.7 679.6 L
+569.7 668.6 545.7 663.8 532.8 673.9 C
+487.2 697.9 467.5 754.5 413.2 772.8 C
+393.1 778.0 387.3 771.8 367.2 760.3 C
+360.9 755.5 357.6 744.9 351.3 740.6 C
+347.0 740.6 349.9 743.5 344.6 747.3 C
+344.1 748.8 343.6 750.2 343.6 750.2 C
+322.5 770.8 L
+312.9 775.2 300.9 784.3 287.0 779.0 C
+283.6 777.1 281.7 776.1 279.3 775.2 C
+250.0 750.7 229.4 705.6 181.4 697.4 C
+165.6 705.1 160.3 715.2 150.7 733.9 C
+130.5 685.4 L
+142.5 663.3 L
+147.3 661.9 147.3 660.4 151.2 655.6 C
+160.8 650.4 169.9 649.4 182.8 655.2 C
+212.1 676.8 L
+213.1 677.7 214.0 678.7 216.0 679.2 C
+238.5 695.5 250.5 727.6 279.3 735.3 C
+296.1 727.2 312.4 715.6 326.8 695.5 C
+330.2 688.3 331.6 684.9 335.5 681.1 C
+345.1 694.5 352.8 717.6 372.9 721.9 C
+423.3 726.7 453.6 670.5 498.2 631.6 C
+510.7 624.4 517.4 621.1 528.4 619.2 C
+f
+%%Trailer
+end
+showpage
--- /dev/null
+% include file for the Gnus refcard and booklet
+\def\progver{5.0}\def\refver{5.0} % program and refcard versions
+\def\date{16 September 1995}
+\def\author{Vladimir Alexiev $<$vladimir@cs.ualberta.ca$>$}
+\raggedbottom\raggedright
+\newlength{\logowidth}\setlength{\logowidth}{6.861in}
+\newlength{\logoheight}\setlength{\logoheight}{7.013in}
+\newlength{\keycolwidth}
+\newenvironment{keys}[1]% #1 is the widest key
+ {\nopagebreak%\noindent%
+ \settowidth{\keycolwidth}{#1}%
+ \addtolength{\keycolwidth}{\tabcolsep}%
+ \addtolength{\keycolwidth}{-\columnwidth}%
+ \begin{tabular}{@{}l@{\hspace{\tabcolsep}}p{-\keycolwidth}@{}}}%
+ {\end{tabular}\\}
+\catcode`\^=12 % allow ^ to be typed literally
+\newcommand{\B}[1]{{\bf#1})} % bold l)etter
+
+\def\Title{
+\begin{center}
+{\bf\LARGE Gnus \progver\ Reference \Guide\\}
+%{\normalsize \Guide\ version \refver}
+\end{center}
+}
+
+\newcommand\Logo[1]{\centerline{
+\makebox[\logoscale\logowidth][l]{\vbox to \logoscale\logoheight
+{\vfill\special{psfile=gnuslogo.#1}}\vspace{-\baselineskip}}}}
+
+\def\CopyRight{
+\begin{center}
+Copyright \copyright\ 1995 Free Software Foundation, Inc.\\*
+Copyright \copyright\ 1995 \author.\\*
+Created from the Gnus manual Copyright \copyright\ 1994 Lars Magne
+Ingebrigtsen.\\*
+and the Emacs Help Bindings feature (C-h b).\\*
+Gnus logo copyright \copyright\ 1995 Luis Fernandes.\\*
+\end{center}
+
+Permission is granted to make and distribute copies of this reference
+\guide{} provided the copyright notice and this permission are preserved on
+all copies. Please send corrections, additions and suggestions to the
+above email address. \Guide{} last edited on \date.
+}
+
+\def\Notes{
+\subsec{Notes}
+{\samepage
+Gnus is complex. Currently it has some 346 interactive (user-callable)
+functions. Of these 279 are in the two major modes (Group and
+Summary/Article). Many of these functions have more than one binding, some
+have 3 or even 4 bindings. The total number of keybindings is 389. So in
+order to save 40\% space, every function is listed only once on this
+\guide, under the ``more logical'' binding. Alternative bindings are given
+in parentheses in the beginning of the description.
+
+Many Gnus commands are affected by the numeric prefix. Normally you enter a
+prefix by holding the Meta key and typing a number, but in most Gnus modes
+you don't need to use Meta since the digits are not self-inserting. The
+prefixed behavior of commands is given in [brackets]. Often the prefix is
+used to specify:
+
+\quad [distance] How many objects to move the point over.
+
+\quad [scope] How many objects to operate on (including the current one).
+
+\quad [p/p] The ``Process/Prefix Convention'': If a prefix is given then it
+determines how many objects to operate on. Else if there are some objects
+marked with the process mark \#, these are operated on. Else only the
+current object is affected.
+
+\quad [level] A group subscribedness level. Only groups with a lower or
+equal level will be affected by the operation. If no prefix is given,
+`gnus-group-default-list-level' is used. If
+`gnus-group-use-permanent-levels', then a prefix to the `g' and `l'
+commands will also set the default level.
+
+\quad [score] An article score. If no prefix is given,
+`gnus-summary-default-score' is used.
+%Some functions were not yet documented at the time of creating this
+%\guide and are clearly indicated as such.
+\\*[\baselineskip]
+\begin{keys}{C-c C-i}
+C-c C-i & Go to the Gnus online {\bf info}.\\
+C-c C-b & Send a Gnus {\bf bug} report.\\
+\end{keys}
+}}
+
+\def\GroupLevels{
+\subsec{Group Subscribedness Levels}
+The table below assumes that you use the default Gnus levels.
+Fill your user-specific levels in the blank cells.\\[1\baselineskip]
+
+\begin{tabular}{|c|l|l|}
+\hline
+Level & Groups & Status \\
+\hline
+1 & mail groups & \\
+2 & mail groups & \\
+3 & & subscribed \\
+4 & & \\
+5 & default list level & \\
+\hline
+6 & & unsubscribed \\
+7 & & \\
+\hline
+8 & & zombies \\
+\hline
+9 & & killed \\
+\hline
+\end{tabular}
+}
+
+\def\Marks{
+\subsec{Mark Indication Characters}
+{\samepage If a command directly sets a mark, it is shown in parentheses.\\*
+\newlength{\markcolwidth}
+\settowidth{\markcolwidth}{` '}% widest character
+\addtolength{\markcolwidth}{4\tabcolsep}
+\addtolength{\markcolwidth}{-\columnwidth}
+\newlength{\markdblcolwidth}
+\setlength{\markdblcolwidth}{\columnwidth}
+\addtolength{\markdblcolwidth}{-2\tabcolsep}
+\begin{tabular}{|c|p{-\markcolwidth}|}
+\hline
+\multicolumn{2}{|p{\markdblcolwidth}|}{{\bf ``Read'' Marks.}
+ All these marks appear in the first column of the summary line, and so
+ are mutually exclusive.}\\
+\hline
+` ' & (M-u, M SPC, M c) Not read.\\
+! & (!, M !, M t) Ticked (interesting).\\
+? & (?, M ?) Dormant (only followups are interesting).\\
+C & (C, S c) {\bf Canceled} (only for your own articles).\\
+E & (E, M e, M x) {\bf Expirable}. Only has effect in mail groups.\\
+\hline\hline
+\multicolumn{2}{|p{\markdblcolwidth}|}{The marks below mean that the article
+ is read (killed, uninteresting), and have more or less the same effect.
+ Some commands however explicitly differentiate between them (e.g.\ M
+ M-C-r, adaptive scoring).}\\
+\hline
+r & (d, M d, M r) Deleted (marked as {\bf read}).\\
+C & (M C; M C-c; M H; c, Z c; Z n; Z C) Killed by {\bf catch-up}.\\
+O & {\bf Old} (marked read in a previous session).\\
+K & (k, M k; C-k, M K) {\bf Killed}.\\
+R & {\bf Read} (viewed in actuality).\\
+X & Killed by a kill file.\\
+Y & Killed due to low score.\\
+\hline\multicolumn{2}{c}{\vspace{1ex}}\\\hline
+\multicolumn{2}{|p{\markdblcolwidth}|}{{\bf Other marks}}\\
+\hline
+\# & (\#, M \#, M P p) Processable (will be affected by the next operation).\\
+A & {\bf Answered} (followed-up or replied).\\
++ & Over default score.\\
+$-$ & Under default score.\\
+= & Has children (thread underneath it). Add `\%e' to
+ `gnus-summary-line-format'.\\
+\hline
+\end{tabular}
+}}
+
+\def\GroupMode{
+\sec{Group Mode}
+\begin{keys}{C-c M-C-x}
+RET & (=) Select this group. [Prefix: how many (read) articles to fetch.
+Positive: newest articles, negative: oldest ones.]\\
+SPC & Select this group and display the first unread article. [Same
+prefix as above.]\\
+? & Give a very short help message.\\
+$<$ & Go to the beginning of the Group buffer.\\
+$>$ & Go to the end of the Group buffer.\\
+, & Jump to the lowest-level group with unread articles.\\
+. & Jump to the first group with unread articles.\\
+^ & Enter the Server buffer mode.\\
+a & Post an {\bf article} to a group.\\
+b & Find {\bf bogus} groups and delete them.\\
+c & Mark all unticked articles in this group as read ({\bf catch-up}).
+[p/p]\\
+g & Check the server for new articles ({\bf get}). [level]\\
+j & {\bf Jump} to a group.\\
+m & {\bf Mail} a message to someone.\\
+n & Go to the {\bf next} group with unread articles. [distance]\\
+p & (DEL) Go to the {\bf previous} group with unread articles.
+[distance]\\
+q & {\bf Quit} Gnus.\\
+r & Read the init file ({\bf reset}).\\
+s & {\bf Save} the `.newsrc.eld' file (and `.newsrc' if
+`gnus-save-newsrc-file').\\
+z & Suspend (kill all buffers of) Gnus.\\
+B & {\bf Browse} a foreign server.\\
+C & Mark all articles in this group as read ({\bf Catch-up}). [p/p]\\
+F & {\bf Find} new groups and process them.\\
+N & Go to the {\bf next} group. [distance]\\
+P & Go to the {\bf previous} group. [distance]\\
+Q & {\bf Quit} Gnus without saving any startup (.newsrc) files.\\
+R & {\bf Restart} Gnus.\\
+V & Display the Gnus {\bf version} number.\\
+Z & Clear the dribble buffer.\\
+C-c C-d & Show the {\bf description} of this group. [Prefix: re-read it
+from the server.]\\
+C-c C-s & {\bf Sort} the groups by name, number of unread articles, or level
+(depending on `gnus-group-sort-function').\\
+C-c C-x & Run all expirable articles in this group through the {\bf expiry}
+process.\\
+C-c M-C-x & Run all articles in all groups through the {\bf expiry} process.\\
+C-x C-t & {\bf Transpose} two groups.\\
+M-d & {\bf Describe} ALL groups. [Prefix: re-read the description from the
+server.]\\
+M-f & Fetch this group's {\bf FAQ} (using ange-ftp).\\
+M-g & Check the server for new articles in this group ({\bf get}). [p/p]\\
+M-n & Go to the {\bf previous} unread group on the same or lower level.
+[distance]\\
+M-p & Go to the {\bf next} unread group on the same or lower level.
+[distance]\\
+\end{keys}
+}
+
+\def\GroupCommands{
+\subsec{List Groups}
+{\samepage
+\begin{keys}{A m}
+A a & (C-c C-a) List all groups whose names match a regexp ({\bf
+apropos}).\\
+A d & List all groups whose names or {\bf descriptions} match a regexp.\\
+A k & (C-c C-l) List all {\bf killed} groups.\\
+A m & List groups that {\bf match} a regexp and have unread articles.
+[level]\\
+A s & (l) List {\bf subscribed} groups with unread articles. [level]\\
+A u & (L) List all groups (including {\bf unsubscribed}). [If no prefix
+is given, level 7 is the default]\\
+A z & List the {\bf zombie} groups.\\
+A M & List groups that {\bf match} a regexp.\\
+\end{keys}
+}
+
+\subsec{Create/Edit Foreign Groups}
+{\samepage
+The select methods are indicated in parentheses.\\*
+\begin{keys}{G m}
+G a & Make the Gnus list {\bf archive} group. (nndir over ange-ftp)\\
+G d & Make a {\bf directory} group (every file must be a posting and files
+must have numeric names). (nndir)\\
+G e & (M-e) {\bf Edit} this group's select method.\\
+G f & Make a group based on a {\bf file}. (nndoc)\\
+G h & Make the Gnus {\bf help} (documentation) group. (nndoc)\\
+G k & Make a {\bf kiboze} group. (nnkiboze)\\
+G m & {\bf Make} a new group.\\
+G p & Edit this group's {\bf parameters}.\\
+G v & Add this group to a {\bf virtual} group. [p/p]\\
+G D & Enter a {\bf directory} as a (temporary) group. (nneething without
+recording articles read.)\\
+G E & {\bf Edit} this group's info (select method, articles read, etc).\\
+G V & Make a new empty {\bf virtual} group. (nnvirtual)\\
+\end{keys}
+You can also create mail-groups and read your mail with Gnus (very useful
+if you are subscribed to any mailing lists), using one of the methods
+nnmbox, nnbabyl, nnml, nnmh, or nnfolder. Read about it in the online info
+(C-c C-i g Reading Mail RET).
+}
+
+%\subsubsec{Soup Commands}
+%\begin{keys}{G s w}
+%G s b & gnus-group-brew-soup: not documented.\\
+%G s p & gnus-soup-pack-packet: not documented.\\
+%G s r & nnsoup-pack-replies: not documented.\\
+%G s s & gnus-soup-send-replies: not documented.\\
+%G s w & gnus-soup-save-areas: not documented.\\
+%\end{keys}
+
+\subsec{Mark Groups}
+\begin{keys}{M m}
+M m & (\#) Set the process {\bf mark} on this group. [scope]\\
+M u & (M-\#) Remove the process mark from this group ({\bf unmark}).
+[scope]\\
+M w & Mark all groups in the current region.\\
+\end{keys}
+
+\subsec{Unsubscribe, Kill and Yank Groups}
+\begin{keys}{S w}
+S k & (C-k) {\bf Kill} this group.\\
+S l & Set the {\bf level} of this group. [p/p]\\
+S s & (U) Prompt for a group and toggle its {\bf subscription}.\\
+S t & (u) {\bf Toggle} subscription to this group. [p/p]\\
+S w & (C-w) Kill all groups in the region.\\
+S y & (C-y) {\bf Yank} the last killed group.\\
+S z & Kill all {\bf zombie} groups.\\
+\end{keys}
+}
+
+\def\SummaryMode{
+\sec{Summary Mode} %{Summary and Article Modes}
+\begin{keys}{SPC}
+SPC & (A SPC, A n) Select an article, scroll it one page, move to the
+next one.\\
+DEL & (A DEL, A p, b) Scroll this article one page back. [distance]\\
+RET & Scroll this article one line forward. [distance]\\
+= & Expand the Summary window. [Prefix: shrink it to display the
+Article window]\\
+$<$ & (A $<$, A b) Scroll to the beginning of this article.\\
+$>$ & (A $>$, A e) Scroll to the end of this article.\\
+\& & Execute a command on all articles matching a regexp.
+[Prefix: move backwards.]\\
+j & (G g) Ask for an article number and then {\bf jump} to that summary
+line.\\
+C-t & Toggle {\bf truncation} of summary lines.\\
+M-\& & Execute a command on all articles having the process mark.\\
+M-k & Edit this group's {\bf kill} file.\\
+M-n & (G M-n) Go to the {\bf next} summary line of an unread article.
+[distance]\\
+M-p & (G M-p) Go to the {\bf previous} summary line of an unread article.
+[distance]\\
+M-r & Search through all previous articles for a regexp.\\
+M-s & {\bf Search} through all subsequent articles for a regexp.\\
+M-K & Edit the general {\bf kill} file.\\
+\end{keys}
+}
+
+\def\SortSummary{
+\subsec{Sort the Summary Buffer}
+\begin{keys}{C-c C-s C-a}
+C-c C-s C-a & Sort the summary by {\bf author}.\\
+C-c C-s C-d & Sort the summary by {\bf date}.\\
+C-c C-s C-i & Sort the summary by article score.\\
+C-c C-s C-n & Sort the summary by article {\bf number}.\\
+C-c C-s C-s & Sort the summary by {\bf subject}.\\
+\end{keys}
+}
+
+\def\Asubmap{
+\subsec{Article Buffer Commands}
+\begin{keys}{A m}
+A g & (g) (Re)fetch this article ({\bf get}). [Prefix: just show the
+article.]\\
+A r & (^, A ^) Go to the parent of this article (the {\bf References}
+header).\\
+M-^ & Fetch the article with a given Message-ID.\\
+A s & (s) Perform an i{\bf search} in the article buffer.\\
+A D & (C-d) Un{\bf digestify} this article into a separate group.\\
+\end{keys}
+}
+
+\def\Bsubmap{
+\subsec{Mail-Group Commands}
+{\samepage
+These commands (except `B c') are only valid in a mail group.\\*
+\begin{keys}{B M-C-e}
+B DEL & {\bf Delete} the mail article from disk (!). [p/p]\\
+B c & {\bf Copy} this article from any group to a mail group. [p/p]\\
+B e & {\bf Expire} all expirable articles in this group. [p/p]\\
+B i & {\bf Import} a random file into this group.\\
+B m & {\bf Move} the article from one mail group to another. [p/p]\\
+B q & {\bf Query} where will the article go during fancy splitting\\
+B r & {\bf Respool} this mail article. [p/p]\\
+B w & (e) Edit this article.\\
+B M-C-e & {\bf Expunge} (delete from disk) all expirable articles in this group
+(!). [p/p]\\
+\end{keys}
+}}
+
+\def\Gsubmap{
+\subsec{Select Articles}
+{\samepage
+These commands select the target article. They do not understand the prefix.\\*
+\begin{keys}{G C-n}
+G b & (,) Go to the {\bf best} article (the one with highest score).\\
+G f & (.) Go to the {\bf first} unread article.\\
+G l & (l) Go to the {\bf last} article read.\\
+G n & (n) Go to the {\bf next} unread article.\\
+p & Go to the {\bf previous} unread article.\\
+G p & {\bf Pop} an article off the summary history and go to it.\\
+G N & (N) Go to {\bf the} next article.\\
+G P & (P) Go to the {\bf previous} article.\\
+G C-n & (M-C-n) Go to the {\bf next} article with the same subject.\\
+G C-p & (M-C-p) Go to the {\bf previous} article with the same subject.\\
+\end{keys}
+}}
+
+\def\Hsubmap{
+\subsec{Help Commands}
+\begin{keys}{H d}
+H d & (C-c C-d) {\bf Describe} this group. [Prefix: re-read the description
+from the server.]\\
+H f & Try to fetch the {\bf FAQ} for this group using ange-ftp.\\
+H h & Give a very short {\bf help} message.\\
+H i & (C-c C-i) Go to the Gnus online {\bf info}.\\
+H v & Display the Gnus {\bf version} number.\\
+\end{keys}
+}
+
+\def\Msubmap{
+\subsec{Mark Articles}
+\begin{keys}{M M-C-r}
+d & (M d, M r) Mark this article as read and move to the next one.
+[scope]\\
+D & Mark this article as read and move to the previous one. [scope]\\
+u & (!, M !, M t) Tick this article (mark it as interesting) and move
+to the next one. [scope]\\
+U & Tick this article and move to the previous one. [scope]\\
+M-u & (M SPC, M c) Clear all marks from this article and move to the next
+one. [scope]\\
+M-U & Clear all marks from this article and move to the previous one.
+[scope]\\
+M ? & (?) Mark this article as dormant (only followups are
+interesting). [scope]\\
+M b & Set a {\bf bookmark} in this article.\\
+M e & (E, M x) Mark this article as {\bf expirable}. [scope]\\
+M k & (k) {\bf Kill} all articles with the same subject then select the
+next one.\\
+M B & Remove the {\bf bookmark} from this article.\\
+M C & {\bf Catch-up} the articles that are not ticked.\\
+M D & Show all {\bf dormant} articles (normally they are hidden unless they
+have any followups).\\
+M H & Catch-up (mark read) this group to point ({\bf here}).\\
+M K & (C-k) {\bf Kill} all articles with the same subject as this one.\\
+C-w & Mark all articles between point and mark as read.\\
+M S & (C-c M-C-s) {\bf Show} all expunged articles.\\
+M C-c & {\bf Catch-up} all articles in this group.\\
+M M-r & (x) Expunge all {\bf read} articles from this group.\\
+M M-D & Hide all {\bf dormant} articles.\\
+M M-C-r & Expunge all articles having a given mark.\\
+\end{keys}
+
+\subsubsec{Mark Based on Score}
+\begin{keys}{M s m}
+M V c & {\bf Clear} all marks from all high-scored articles. [score]\\
+M V k & {\bf Kill} all low-scored articles. [score]\\
+M V m & Mark all high-scored articles with a given {\bf mark}. [score]\\
+M V u & Mark all high-scored articles as interesting (tick them). [score]\\
+\end{keys}
+
+\subsubsec{The Process Mark}
+{\samepage
+These commands set and remove the process mark \#. You only need to use
+it if the set of articles you want to operate on is non-contiguous. Else
+use a numeric prefix.\\*
+\begin{keys}{M P R}
+M P a & Mark {\bf all} articles (in series order).\\
+M P p & (\#, M \#) Mark this article.\\
+M P r & Mark all articles in the {\bf region}.\\
+M P s & Mark all articles in the current {\bf series}.\\
+M P t & Mark all articles in this (sub){\bf thread}.\\
+M P u & (M-\#, M M-\#) {\bf Unmark} this article.\\
+M P R & Mark all articles matching a {\bf regexp}.\\
+M P S & Mark all {\bf series} that already contain a marked article.\\
+M P U & {\bf Unmark} all articles.\\
+\end{keys}
+}}
+
+\def\Osubmap{
+\subsec{Output Articles}
+\begin{keys}{O m}
+O f & Save this article in plain {\bf file} format. [p/p]\\
+O h & Save this article in {\bf mh} folder format. [p/p]\\
+O m & Save this article in {\bf mail} format. [p/p]\\
+O o & (o, C-o) Save this article using the default article saver. [p/p]\\
+O p & ($\mid$) Pipe this article to a shell command. [p/p]\\
+O r & Save this article in {\bf rmail} format. [p/p]\\
+O v & Save this article in {\bf vm} format. [p/p]\\
+\end{keys}
+}
+
+\def\Ssubmap{
+\subsec{Post, Followup, Reply, Forward, Cancel}
+{\samepage
+These commands put you in a separate post or mail buffer. After
+editing the article, send it by pressing C-c C-c. If you are in a
+foreign group and want to post the article using the foreign server, give
+a prefix to C-c C-c.\\*
+\begin{keys}{S O m}
+S b & {\bf Both} post a followup to this article, and send a reply.\\
+S c & (C) {\bf Cancel} this article (only works if it is your own).\\
+S f & (f) Post a {\bf followup} to this article.\\
+S m & (m) Send {\bf a} mail to some other person.\\
+S o m & (C-c C-f) Forward this article by {\bf mail} to a person.\\
+S o p & Forward this article as a {\bf post} to a newsgroup.\\
+S p & (a) {\bf Post} an article to this group.\\
+S r & (r) Mail a {\bf reply} to the author of this article.\\
+S s & {\bf Supersede} this article with a new one (only for own
+articles).\\
+S u & {\bf Uuencode} a file and post it as a series.\\
+S B & {\bf Both} post a followup, send a reply, and include the
+original. [p/p]\\
+S F & (F) Post a {\bf followup} and include the original. [p/p]\\
+S O m & Digest these series and forward by {\bf mail}. [p/p]\\
+S O p & Digest these series and forward as a {\bf post} to a newsgroup.
+[p/p]\\
+S R & (R) Mail a {\bf reply} and include the original. [p/p]\\
+\end{keys}
+If you want to cancel or supersede an article you just posted (before it
+has appeared on the server), go to the *post-news* buffer, change
+`Message-ID' to `Cancel' or `Supersedes' and send it again with C-c C-c.
+}}
+
+\def\Tsubmap{
+\subsec{Thread Commands}
+\begin{keys}{T \#}
+T \# & Mark this thread with the process mark.\\
+T d & Move to the next article in this thread ({\bf down}). [distance]\\
+T h & {\bf Hide} this (sub)thread.\\
+T i & {\bf Increase} the score of this thread.\\
+T k & (M-C-k) {\bf Kill} the current (sub)thread. [Negative prefix:
+tick it, positive prefix: unmark it.]\\
+T l & (M-C-l) {\bf Lower} the score of this thread.\\
+T n & (M-C-f) Go to the {\bf next} thread. [distance]\\
+T p & (M-C-b) Go to the {\bf previous} thread. [distance]\\
+T s & {\bf Show} the thread hidden under this article.\\
+T u & Move to the previous article in this thread ({\bf up}). [distance]\\
+T H & {\bf Hide} all threads.\\
+T S & {\bf Show} all hidden threads.\\
+T T & (M-C-t) {\bf Toggle} threading.\\
+\end{keys}
+}
+
+\def\Vsubmap{
+\subsec{Score (Value) Commands}
+{\samepage
+Read about Adaptive Scoring in the online info.\\*
+\begin{keys}{\bf A p m l}
+V a & {\bf Add} a new score entry, specifying all elements.\\
+V c & Specify a new score file as {\bf current}.\\
+V e & {\bf Edit} the current score alist.\\
+V f & Edit a score {\bf file} and make it the current one.\\
+V m & {\bf Mark} all articles below a given score as read.\\
+V s & Set the {\bf score} of this article.\\
+V t & Display all score rules applied to this article ({\bf track}).\\
+V x & {\bf Expunge} all low-scored articles. [score]\\
+V C & {\bf Customize} the current score file through a user-friendly
+interface.\\
+V S & Display the {\bf score} of this article.\\
+\bf A p m l& Make a scoring entry based on this article.\\
+\end{keys}
+
+The four letters stand for:\\*
+\quad \B{A}ction: I)ncrease, L)ower;\\*
+\quad \B{p}art: a)utor (from), s)ubject, x)refs (cross-posting), d)ate, l)ines,
+message-i)d, t)references (parent), f)ollowup, b)ody, h)ead (all headers);\\*
+\quad \B{m}atch type:\\*
+\qquad string: s)ubstring, e)xact, r)egexp, f)uzzy,\\*
+\qquad date: b)efore, a)t, n)this,\\*
+\qquad number: $<$, =, $>$;\\*
+\quad \B{l}ifetime: t)emporary, p)ermanent, i)mmediate.
+
+If you type the second letter in uppercase, the remaining two are assumed
+to be s)ubstring and t)emporary.
+If you type the third letter in uppercase, the last one is assumed to be
+t)emporary.
+
+\quad Extra keys for manual editing of a score file:\\*
+\begin{keys}{C-c C-c}
+C-c C-c & Finish editing the score file.\\
+C-c C-d & Insert the current {\bf date} as number of days.\\
+\end{keys}
+}}
+
+\def\Wsubmap{
+\subsec{Wash the Article Buffer}
+\begin{keys}{W C-c}
+W b & Make Message-IDs and URLs in the article to mouse-clickable {\bf
+ buttons}.\\
+W c & Remove extra {\bf CRs} (^M) from the article.\\
+W f & Look for and display any X-{\bf Face} headers.\\
+W l & (w) Remove page breaks ({\bf^L}) from the article.\\
+W m & Toggle {\bf MIME} processing.\\
+W o & Treat {\bf overstrike} or underline (^H\_) in the article.\\
+W q & Treat {\bf quoted}-printable in the article.\\
+W r & (C-c C-r) Do a Caesar {\bf rotate} (rot13) on the article.\\
+W t & (t) {\bf Toggle} the displaying of all headers.\\
+v & Toggle permanent {\bf verbose} displaying of all headers.\\
+W w & Do word {\bf wrap} in the article.\\
+W T e & Convert the article timestamp to time {\bf elapsed} since sent.\\
+W T l & Convert the article timestamp to the {\bf local} timezone.\\
+W T u & (W T z) Convert the article timestamp to {\bf UTC} ({\bf Zulu},
+GMT).\\
+\end{keys}
+
+\subsubsec{Hide/Highlight Parts of the Article}
+\begin{keys}{W W C-c}
+W W a & Hide {\bf all} unwanted parts. Calls W W h, W W s, W W C-c.\\
+W W c & Hide article {\bf citation}.\\
+W W h & Hide article {\bf headers}.\\
+W W s & Hide article {\bf signature}.\\
+W W C-c & Hide article {\bf citation} using a more intelligent algorithm.\\
+%\end{keys}
+%
+%\subsubsec{Highlight Parts of the Article}
+%\begin{keys}{W H A}
+W H a & Highlight {\bf all} parts. Calls W b, W H c, W H h, W H s.\\
+W H c & Highlight article {\bf citation}.\\
+W H h & Highlight article {\bf headers}.\\
+W H s & Highlight article {\bf signature}.\\
+\end{keys}
+}
+
+\def\Xsubmap{
+\subsec{Extract Series (Uudecode etc)}
+{\samepage
+Gnus recognizes if the current article is part of a series (multipart
+posting whose parts are identified by numbers in their subjects, e.g.{}
+1/10\dots10/10) and processes the series accordingly. You can mark and
+process more than one series at a time. If the posting contains any
+archives, they are expanded and gathered in a new group.\\*
+\begin{keys}{X p}
+X b & Un-{\bf binhex} these series. [p/p]\\
+X o & Simply {\bf output} these series (no decoding). [p/p]\\
+X p & Unpack these {\bf postscript} series. [p/p]\\
+X s & Un-{\bf shar} these series. [p/p]\\
+X u & {\bf Uudecode} these series. [p/p]\\
+\end{keys}
+
+Each one of these commands has four variants:\\*
+\begin{keys}{X v \bf Z}
+X \bf z & Decode these series. [p/p]\\
+X \bf Z & Decode and save these series. [p/p]\\
+X v \bf z & Decode and view these series. [p/p]\\
+X v \bf Z & Decode, save and view these series. [p/p]\\
+\end{keys}
+where {\bf z} or {\bf Z} identifies the decoding method (b, o, p, s, u).
+
+An alternative binding for the most-often used of these commands is\\*
+\begin{keys}{C-c C-v C-v}
+C-c C-v C-v & (X v u) Uudecode and view these series. [p/p]\\
+\end{keys}
+}}
+
+\def\Zsubmap{
+\subsec{Exit the Current Group}
+\begin{keys}{Z G}
+Z c & (c) Mark all unticked articles as read ({\bf catch-up}) and exit.\\
+Z n & Mark all articles as read and go to the {\bf next} group.\\
+Z C & Mark all articles as read ({\bf catch-up}) and exit.\\
+Z E & (Q) {\bf Exit} without updating the group information.\\
+Z G & (M-g) Check for new articles in this group ({\bf get}).\\
+Z N & Exit and go to {\bf the} next group.\\
+Z P & Exit and go to the {\bf previous} group.\\
+Z R & Exit this group, and then enter it again ({\bf reenter}).
+[Prefix: select all articles, read and unread.]\\
+Z Z & (q, Z Q) Exit this group.\\
+\end{keys}
+}
+
+\def\ArticleMode{
+\sec{Article Mode}
+{\samepage
+% All keys for Summary mode also work in Article mode.
+The normal navigation keys work in Article mode.
+Some additional keys are:\\*
+\begin{keys}{C-c C-m}
+RET & (middle mouse button) Activate the button at point to follow
+an URL or Message-ID.\\
+TAB & Move the point to the next button.\\
+h & (s) Go to the {\bf header} line of the article in the {\bf
+summary} buffer.\\
+C-c ^ & Get the article with the Message-ID near point.\\
+C-c C-m & {\bf Mail} reply to the address near point (prefix: include the
+original).\\
+\end{keys}
+}}
+
+\def\ServerMode{
+\sec{Server Mode}
+{\samepage
+To enter this mode, press `^' while in Group mode.\\*
+\begin{keys}{SPC}
+SPC & (RET) Browse this server.\\
+a & {\bf Add} a new server.\\
+c & {\bf Copy} this server.\\
+e & {\bf Edit} a server.\\
+k & {\bf Kill} this server. [scope]\\
+l & {\bf List} all servers.\\
+q & Return to the group buffer ({\bf quit}).\\
+y & {\bf Yank} the previously killed server.\\
+\end{keys}
+}}
+
+\def\BrowseServer{
+\sec{Browse Server Mode}
+{\samepage
+To enter this mode, press `B' while in Group mode.\\*
+\begin{keys}{RET}
+RET & Enter the current group.\\
+SPC & Enter the current group and display the first article.\\
+? & Give a very short help message.\\
+n & Go to the {\bf next} group. [distance]\\
+p & Go to the {\bf previous} group. [distance]\\
+q & (l) {\bf Quit} browse mode.\\
+u & Subscribe to the current group. [scope]\\
+\end{keys}
+}}
--- /dev/null
+\input texinfo @c -*-texinfo-*-
+
+@setfilename message
+@settitle Message 0.110 Manual
+@synindex fn cp
+@synindex vr cp
+@synindex pg cp
+@iftex
+@finalout
+@end iftex
+@setchapternewpage odd
+
+@ifinfo
+
+This file documents Message, the Emacs message composition mode.
+
+Copyright (C) 1996 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through Tex and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions.
+@end ifinfo
+
+@tex
+
+@titlepage
+@title Message 0.110 Manual
+
+@author by Lars Magne Ingebrigtsen
+@page
+
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1996 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions.
+
+@end titlepage
+@page
+
+@end tex
+
+@node Top
+@top Message
+
+All message composition (both mail and news) takes place in Message mode
+buffers.
+
+@menu
+* Interface:: Setting up message buffers.
+* Commands:: Commands you can execute in message mode buffers.
+* Variables:: Customizing the message buffers.
+* Compatibility:: Making Message backwards compatible.
+* Index:: Variable, function and concept index.
+* Key Index:: List of Message mode keys.
+@end menu
+
+This manual corresponds to Message 0.110. Message is distributed with
+the Gnus distribution bearing the same version number as this manual
+has.
+
+
+@node Interface
+@chapter Interface
+
+When a program (or a person) wants to respond to a message -- reply,
+follow up, forward, cancel -- the program (or person) should just put
+point in the buffer where the message is and call the required command.
+@code{Message} will then pop up a new @code{message} mode buffer with
+appropriate headers filled out, and the user can edit the message before
+sending it.
+
+@menu
+* New Mail Message:: Editing a brand new mail message.
+* New News Message:: Editing a brand new news message.
+* Reply:: Replying via mail.
+* Wide Reply:: Responding to all people via mail.
+* Followup:: Following up via news.
+* Canceling News:: Canceling a news article.
+* Superseding:: Superseding a message.
+* Forwarding:: Forwarding a message via news or mail.
+* Resending:: Resending a mail message.
+* Bouncing:: Bouncing a mail message.
+@end menu
+
+
+@node New Mail Message
+@section New Mail Message
+
+@findex message-mail
+The @code{message-mail} command pops up a new message buffer.
+
+Two optional parameters are accepted: The first will be used as the
+@code{To} header and the second as the @code{Subject} header. If these
+aren't present, those two headers will be empty.
+
+
+@node New News Message
+@section New News Message
+
+@findex message-news
+The @code{message-news} command pops up a new message buffer.
+
+This function accepts two optional parameters. The first will be used
+as the @code{Newsgroups} header and the second as the @code{Subject}
+header. If these aren't present, those two headers will be empty.
+
+
+@node Reply
+@section Reply
+
+@findex message-reply
+The @code{message-reply} function pops up a message buffer that's a
+reply to the message in the current buffer.
+
+@vindex message-reply-to-function
+Message uses the normal methods to determine where replies are to go,
+but you can change the behavior to suit your needs by fiddling with the
+@code{message-reply-to-function} variable.
+
+If you want the replies to go to the @code{Sender} instead of the
+@code{From}, you could do something like this:
+
+@lisp
+(setq message-reply-to-function
+ (lambda ()
+ (cond ((equal (mail-fetch-field "from") "somebody")
+ (mail-fetch-field "sender"))
+ (t
+ nil))))
+@end lisp
+
+This function will be called narrowed to the head of the article that is
+being replied to.
+
+As you can see, this function should return a string if it has an
+opinion as to what the To header should be. If it does not, it should
+just return @code{nil}, and the normal methods for determining the To
+header will be used.
+
+This function can also return a list. In that case, each list element
+should be a cons, where the car should be the name of an header
+(eg. @code{Cc}) and the cdr should be the header value
+(eg. @samp{larsi@@ifi.uio.no}). All these headers will be inserted into
+the head of the outgoing mail.
+
+
+@node Wide Reply
+@section Wide Reply
+
+@findex message-wide-reply
+The @code{message-wide-reply} pops up a message buffer that's a wide
+reply to the message in the current buffer. A @dfn{wide reply} is a
+reply that goes out to all people listed in the @code{To}, @code{From}
+(or @code{Reply-to}) and @code{Cc} headers.
+
+@vindex message-wide-reply-to-function
+Message uses the normal methods to determine where wide replies are to go,
+but you can change the behavior to suit your needs by fiddling with the
+@code{message-wide-reply-to-function}. It is used in the same way as
+@code{message-reply-to-function} (@pxref{Reply}).
+
+@findex rmail-dont-reply-to-names
+Addresses that match the @code{rmail-dont-reply-to-names} regular
+expression will be removed from the @code{Cc} header.
+
+
+@node Followup
+@section Followup
+
+@findex message-followup
+The @code{message-followup} command pops up a message buffer that's a
+followup to the message in the current buffer.
+
+@vindex message-followup-to-function
+Message uses the normal methods to determine where followups are to go,
+but you can change the behavior to suit your needs by fiddling with the
+@code{message-followup-to-function}. It is used in the same way as
+@code{message-reply-to-function} (@pxref{Reply}).
+
+@vindex message-use-followup-to
+The @code{message-use-followup-to} variable says what to do about
+@code{Followup-To} headers. If it is @code{use}, always use the value.
+If it is @code{ask} (which is the default), ask whether to use the
+value. If it is @code{t}, use the value unless it is @samp{poster}. If
+it is @code{nil}, don't use the value.
+
+
+@node Canceling News
+@section Canceling News
+
+@findex message-cancel-news
+The @code{message-cancel-news} command cancels the article in the
+current buffer.
+
+
+@node Superseding
+@section Superseding
+
+@findex message-supersede
+The @code{message-supersede} command pops up a message buffer that will
+supersede the message in the current buffer.
+
+@vindex message-ignored-supersedes-headers
+Headers matching the @code{message-ignored-supersedes-headers} are
+removed before popping up the new message buffer. The default is@*
+@samp{^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|@*
+^Received:\\|^X-From-Line:\\|Return-Path:}.
+
+
+
+@node Forwarding
+@section Forwarding
+
+@findex message-forward
+The @code{message-forward} command pops up a message buffer to forward
+the message in the current buffer. If given a prefix, forward using
+news.
+
+@table @code
+@item message-forward-start-separator
+@vindex message-forward-start-separator
+Delimiter inserted before forwarded messages. The default is@*
+@samp{------- Start of forwarded message -------\n}.
+
+@vindex message-forward-end-separator
+@item message-forward-end-separator
+@vindex message-forward-end-separator
+Delimiter inserted after forwarded messages. The default is@*
+@samp{------- End of forwarded message -------\n}.
+
+@item message-signature-before-forwarded-message
+@vindex message-signature-before-forwarded-message
+If this variable is @code{t}, which it is by default, your personal
+signature will be inserted before the forwarded message. If not, the
+forwarded message will be inserted first in the new mail.
+
+@item message-included-forward-headers
+@vindex message-included-forward-headers
+Regexp matching header lines to be included in forwarded messages.
+
+@end table
+
+
+@node Resending
+@section Resending
+
+@findex message-resend
+The @code{message-resend} command will prompt the user for an address
+and resend the message in the current buffer to that address.
+
+@vindex message-ignored-resent-headers
+Headers that match the @code{message-ignored-resent-headers} regexp will
+be removed before sending the message. The default is
+@samp{^Return-receipt}.
+
+
+@node Bouncing
+@section Bouncing
+
+@findex message-bounce
+The @code{message-bounce} command will, if the current buffer contains a
+bounced mail message, pop up a message buffer stripped of the bounce
+information. A @dfn{bounced message} is typically a mail you've sent
+out that has been returned by some @code{mailer-daemon} as
+undeliverable.
+
+@vindex message-ignored-bounced-headers
+Headers that match the @code{message-ignored-bounced-headers} regexp
+will be removed before popping up the buffer. The default is
+@samp{^Received:}.
+
+
+@node Commands
+@chapter Commands
+
+@menu
+* Header Commands:: Commands for moving to headers.
+* Movement:: Moving around in message buffers.
+* Insertion:: Inserting things into message buffers.
+* Various Commands:: Various things.
+* Sending:: Actually sending the message.
+* Mail Aliases:: How to use mail aliases.
+@end menu
+
+
+@node Header Commands
+@section Header Commands
+
+All these commands move to the header in question. If it doesn't exist,
+it will be inserted.
+
+@table @kbd
+
+@item C-c ?
+@kindex C-c ?
+@findex message-goto-to
+Describe the message mode.
+
+@item C-c C-f C-t
+@kindex C-c C-f C-t
+@findex message-goto-to
+Go to the @code{To} header (@code{message-goto-to}).
+
+@item C-c C-f C-b
+@kindex C-c C-f C-b
+@findex message-goto-bcc
+Go to the @code{Bcc} header (@code{message-goto-bcc}).
+
+@item C-c C-f C-f
+@kindex C-c C-f C-f
+@findex message-goto-fcc
+Go to the @code{Fcc} header (@code{message-goto-fcc}).
+
+@item C-c C-f C-c
+@kindex C-c C-f C-c
+@findex message-goto-cc
+Go to the @code{Cc} header (@code{message-goto-cc}).
+
+@item C-c C-f C-s
+@kindex C-c C-f C-s
+@findex message-goto-subject
+Go to the @code{Subject} header (@code{message-goto-subject}).
+
+@item C-c C-f C-r
+@kindex C-c C-f C-r
+@findex message-goto-reply-to
+Go to the @code{Reply-To} header (@code{message-goto-reply-to}).
+
+@item C-c C-f C-n
+@kindex C-c C-f C-n
+@findex message-goto-newsgroups
+Go to the @code{Newsgroups} header (@code{message-goto-newsgroups}).
+
+@item C-c C-f C-d
+@kindex C-c C-f C-d
+@findex message-goto-distribution
+Go to the @code{Distribution} header (@code{message-goto-distribution}).
+
+@item C-c C-f C-o
+@kindex C-c C-f C-o
+@findex message-goto-followup-to
+Go to the @code{Followup-To} header (@code{message-goto-followup-to}).
+
+@item C-c C-f C-k
+@kindex C-c C-f C-k
+@findex message-goto-keywords
+Go to the @code{Keywords} header (@code{message-goto-keywords}).
+
+@item C-c C-f C-u
+@kindex C-c C-f C-u
+@findex message-goto-summary
+Go to the @code{Summary} header (@code{message-goto-summary}).
+
+@end table
+
+
+@node Movement
+@section Movement
+
+@table @kbd
+@item C-c C-b
+@kindex C-c C-b
+@findex message-goto-body
+Move to the beginning of the body of the message
+(@code{message-goto-body}).
+
+@item C-c C-i
+@kindex C-c C-i
+@findex message-goto-signature
+Move to the signature of the message (@code{message-goto-signature}).
+
+@end table
+
+
+@node Insertion
+@section Insertion
+
+@table @kbd
+
+@item C-c C-y
+@kindex C-c C-y
+@findex message-yank-original
+Yank the message that's being replied to into the message buffer
+(@code{message-yank-original}).
+
+@item C-c C-q
+@kindex C-c C-q
+@findex message-fill-yanked-message
+Fill the yanked message (@code{message-fill-yanked-message}).
+
+@item C-c C-w
+@kindex C-c C-w
+@findex message-insert-signature
+Insert a signature at the end of the buffer
+(@code{message-insert-signature}).
+
+@end table
+
+@table @code
+@item message-ignored-cited-headers
+@vindex message-ignored-cited-headers
+All headers that match this regexp will be removed from yanked
+messages. The default is @samp{.}, which means that all headers will be
+removed.
+
+@item message-citation-line-function
+@vindex message-citation-line-function
+Function called to insert the citation line. The default is
+@code{message-insert-citation-line}.
+
+@item message-yank-prefix
+@vindex message-yank-prefix
+@cindex yanking
+@cindex quoting
+When you are replying to or following up an article, you normally want
+to quote the person you are answering. Inserting quoted text is done by
+@dfn{yanking}, and each quoted line you yank will have
+@code{message-yank-prefix} prepended to it. The default is @samp{> }.
+If it is @code{nil}, just indent the message.
+
+@item message-indentation-spaces
+@vindex message-indentation-spaces
+Number of spaces to indent yanked messages.
+
+@item message-cite-function
+@vindex message-cite-function
+@findex message-cite-original
+@findex sc-cite-original
+@cindex Supercite
+Function for citing an original message. The default is
+@code{message-cite-original}. You can also set it to
+@code{sc-cite-original} to use Supercite.
+
+@item message-indent-citation-function
+@vindex message-indent-citation-function
+Function for modifying a citation just inserted in the mail buffer.
+This can also be a list of functions. Each function can find the
+citation between @code{(point)} and @code{(mark t)}. And each function
+should leave point and mark around the citation text as modified.
+
+@item message-signature
+@vindex message-signature
+String to be inserted at the end of the message buffer. If @code{t}
+(which is the default), the @code{message-signature-file} file will be
+inserted instead. If a function, the result from the function will be
+used instead. If a form, the result from the form will be used instead.
+If this variable is @code{nil}, no signature will be inserted at all.
+
+@item message-signature-file
+@vindex message-signature-file
+File containing the signature to be inserted at the end of the buffer.
+The default is @samp{~/.signature}.
+
+@end table
+
+Note that RFC1036 says that a signature should be preceded by the three
+characters @samp{-- } on a line by themselves. This is to make it
+easier for the recipient to automatically recognize and process the
+signature. So don't remove those characters, even though you might feel
+that they ruin your beautiful design, like, totally.
+
+Also note that no signature should be more than four lines long.
+Including ASCII graphics is an efficient way to get everybody to believe
+that you are silly and have nothing important to say.
+
+
+
+@node Various Commands
+@section Various Commands
+
+@table @kbd
+
+@item C-c C-r
+@kindex C-c C-r
+@findex message-caesar-buffer-body
+Caesar rotate (aka. rot13) the current message
+(@code{message-caesar-buffer-body}). If narrowing is in effect, just
+rotate the visible portion of the buffer. A numerical prefix says how
+many places to rotate the text. The default is 13.
+
+@item C-c C-e
+@kindex C-c C-e
+@findex message-elide-region
+Elide the text between point and mark (@code{message-elide-region}).
+The text is killed and an ellipsis (@samp{[...]}) will be inserted in
+its place.
+
+@item C-c C-v
+@kindex C-c C-v
+@findex message-delete-not-region
+Delete all text in the body of the message that is outside the region
+(@code{message-delete-not-region}).
+
+@item M-RET
+@kindex M-RET
+@kindex message-newline-and-reformat
+Insert four newlines, and then reformat if inside quoted text.
+
+Here's an example:
+
+@example
+> This is some quoted text. And here's more quoted text.
+@end example
+
+If point is before @samp{And} and you press @kbd{M-RET}, you'll get:
+
+@example
+> This is some quoted text.
+
+*
+
+> And here's more quoted text.
+@end example
+
+@samp{*} says where point will be placed.
+
+@item C-c C-t
+@kindex C-c C-t
+@findex message-insert-to
+Insert a @code{To} header that contains the @code{Reply-To} or
+@code{From} header of the message you're following up
+(@code{message-insert-to}).
+
+@item C-c C-n
+@kindex C-c C-n
+@findex message-insert-newsgroups
+Insert a @code{Newsgroups} header that reflects the @code{Followup-To}
+or @code{Newsgroups} header of the article you're replying to
+(@code{message-insert-newsgroups}).
+
+@item C-c M-r
+@kindex C-c M-r
+@findex message-rename-buffer
+Rename the buffer (@code{message-rename-buffer}). If given a prefix,
+prompt for a new buffer name.
+
+@end table
+
+
+@node Sending
+@section Sending
+
+@table @kbd
+@item C-c C-c
+@kindex C-c C-c
+@findex message-send-and-exit
+Send the message and bury the current buffer
+(@code{message-send-and-exit}).
+
+@item C-c C-s
+@kindex C-c C-s
+@findex message-send
+Send the message (@code{message-send}).
+
+@item C-c C-d
+@kindex C-c C-d
+@findex message-dont-send
+Bury the message buffer and exit (@code{message-dont-send}).
+
+@item C-c C-k
+@kindex C-c C-k
+@findex message-kill-buffer
+Kill the message buffer and exit (@code{message-kill-buffer}).
+
+@end table
+
+
+
+@node Mail Aliases
+@section Mail Aliases
+@cindex mail aliases
+@cindex aliases
+
+@vindex message-mail-alias-type
+The @code{message-mail-alias-type} variable controls what type of mail
+alias expansion to use. Currently only one form is supported---Message
+uses @code{mailabbrev} to handle mail aliases. If this variable is
+@code{nil}, no mail alias expansion will be performed.
+
+@code{mailabbrev} works by parsing the @file{/etc/mailrc} and
+@file{~/.mailrc} files. These files look like:
+
+@example
+alias lmi "Lars Magne Ingebrigtsen <larsi@@ifi.uio.no>"
+alias ding "ding@@ifi.uio.no (ding mailing list)"
+@end example
+
+After adding lines like this to your @file{~/.mailrc} file, you should
+be able to just write @samp{lmi} in the @code{To} or @code{Cc} (and so
+on) headers and press @kbd{SPC} to expand the alias.
+
+No expansion will be performed upon sending of the message---all
+expansions have to be done explicitly.
+
+
+
+@node Variables
+@chapter Variables
+
+@menu
+* Message Headers:: General message header stuff.
+* Mail Headers:: Customizing mail headers.
+* Mail Variables:: Other mail variables.
+* News Headers:: Customizing news headers.
+* News Variables:: Other news variables.
+* Various Message Variables:: Other message variables.
+* Sending Variables:: Variables for sending.
+* Message Buffers:: How Message names its buffers.
+* Message Actions:: Actions to be performed when exiting.
+@end menu
+
+
+@node Message Headers
+@section Message Headers
+
+Message is quite aggressive on the message generation front. It has
+to be -- it's a combined news and mail agent. To be able to send
+combined messages, it has to generate all headers itself to ensure that
+mail and news copies of messages look sufficiently similar.
+
+@table @code
+
+@item message-generate-headers-first
+@vindex message-generate-headers-first
+If non-@code{nil}, generate all headers before starting to compose the
+message.
+
+@item message-from-style
+@vindex message-from-style
+Specifies how @code{From} headers should look. There are four legal
+values:
+
+@table @code
+@item nil
+Just the address -- @samp{king@@grassland.com}.
+
+@item parens
+@samp{king@@grassland.com (Elvis Parsley)}.
+
+@item angles
+@samp{Elvis Parsley <king@@grassland.com>}.
+
+@item default
+Look like @code{angles} if that doesn't require quoting, and
+@code{parens} if it does. If even @code{parens} requires quoting, use
+@code{angles} anyway.
+
+@end table
+
+@item message-deletable-headers
+@vindex message-deletable-headers
+Headers in this list that were previously generated by Message will be
+deleted before posting. Let's say you post an article. Then you decide
+to post it again to some other group, you naughty boy, so you jump back
+to the @code{*post-buf*} buffer, edit the @code{Newsgroups} line, and
+ship it off again. By default, this variable makes sure that the old
+generated @code{Message-ID} is deleted, and a new one generated. If
+this isn't done, the entire empire would probably crumble, anarchy would
+prevail, and cats would start walking on two legs and rule the world.
+Allegedly.
+
+@item message-default-headers
+@vindex message-default-headers
+This string is inserted at the end of the headers in all message
+buffers.
+
+@end table
+
+
+@node Mail Headers
+@section Mail Headers
+
+@table @code
+@item message-required-mail-headers
+@vindex message-required-mail-headers
+@xref{News Headers}, for the syntax of this variable. It is
+@code{(From Date Subject (optional . In-Reply-To) Message-ID Lines
+(optional . X-Mailer))} by default.
+
+@item message-ignored-mail-headers
+@vindex message-ignored-mail-headers
+Regexp of headers to be removed before mailing. The default is
+@samp{^Gcc:\\|^Fcc:}.
+
+@item message-default-mail-headers
+@vindex message-default-mail-headers
+This string is inserted at the end of the headers in all message
+buffers that are initialized as mail.
+
+@end table
+
+
+@node Mail Variables
+@section Mail Variables
+
+@table @code
+@item message-send-mail-function
+@vindex message-send-mail-function
+Function used to send the current buffer as mail. The default is
+@code{message-send-mail-with-sendmail}. If you prefer using MH
+instead, set this variable to @code{message-send-mail-with-mh}.
+
+@item message-mh-deletable-headers
+@vindex message-mh-deletable-headers
+Most versions of MH doesn't like being fed messages that contain the
+headers in this variable. If this variable is non-@code{nil} (which is
+the default), these headers will be removed before mailing. Set it to
+@code{nil} if your MH can handle these headers.
+
+@end table
+
+
+@node News Headers
+@section News Headers
+
+@vindex message-required-news-headers
+@code{message-required-news-headers} a list of header symbols. These
+headers will either be automatically generated, or, if that's
+impossible, they will be prompted for. The following symbols are legal:
+
+@table @code
+
+@item From
+@cindex From
+@findex user-full-name
+@findex user-mail-address
+This required header will be filled out with the result of the
+@code{message-make-from} function, which depends on the
+@code{message-from-style}, @code{user-full-name},
+@code{user-mail-address} variables.
+
+@item Subject
+@cindex Subject
+This required header will be prompted for if not present already.
+
+@item Newsgroups
+@cindex Newsgroups
+This required header says which newsgroups the article is to be posted
+to. If it isn't present already, it will be prompted for.
+
+@item Organization
+@cindex organization
+This optional header will be filled out depending on the
+@code{message-user-organization} variable.
+@code{message-user-organization-file} will be used if this variable is
+@code{t}. This variable can also be a string (in which case this string
+will be used), or it can be a function (which will be called with no
+parameters and should return a string to be used).
+
+@item Lines
+@cindex Lines
+This optional header will be computed by Message.
+
+@item Message-ID
+@cindex Message-ID
+@vindex mail-host-address
+@findex system-name
+@cindex Sun
+This required header will be generated by Message. A unique ID will be
+created based on the date, time, user name and system name. Message will
+use @code{mail-host-address} as the fully qualified domain name (FQDN)
+of the machine if that variable is defined. If not, it will use
+@code{system-name}, which doesn't report a FQDN on some machines --
+notably Suns.
+
+@item X-Newsreader
+@cindex X-Newsreader
+This optional header will be filled out according to the
+@code{message-newsreader} local variable.
+
+@item X-Mailer
+This optional header will be filled out according to the
+@code{message-mailer} local variable, unless there already is an
+@code{X-Newsreader} header present.
+
+@item In-Reply-To
+This optional header is filled out using the @code{Date} and @code{From}
+header of the article being replied to.
+
+@item Expires
+@cindex Expires
+This extremely optional header will be inserted according to the
+@code{message-expires} variable. It is highly deprecated and shouldn't
+be used unless you know what you're doing.
+
+@item Distribution
+@cindex Distribution
+This optional header is filled out according to the
+@code{message-distribution-function} variable. It is a deprecated and
+much misunderstood header.
+
+@item Path
+@cindex path
+This extremely optional header should probably never be used.
+However, some @emph{very} old servers require that this header is
+present. @code{message-user-path} further controls how this
+@code{Path} header is to look. If it is @code{nil}, use the server name
+as the leaf node. If it is a string, use the string. If it is neither
+a string nor @code{nil}, use the user name only. However, it is highly
+unlikely that you should need to fiddle with this variable at all.
+@end table
+
+@findex yow
+@cindex Mime-Version
+In addition, you can enter conses into this list. The car of this cons
+should be a symbol. This symbol's name is the name of the header, and
+the cdr can either be a string to be entered verbatim as the value of
+this header, or it can be a function to be called. This function should
+return a string to be inserted. For instance, if you want to insert
+@code{Mime-Version: 1.0}, you should enter @code{(Mime-Version . "1.0")}
+into the list. If you want to insert a funny quote, you could enter
+something like @code{(X-Yow . yow)} into the list. The function
+@code{yow} will then be called without any arguments.
+
+If the list contains a cons where the car of the cons is
+@code{optional}, the cdr of this cons will only be inserted if it is
+non-@code{nil}.
+
+Other variables for customizing outgoing news articles:
+
+@table @code
+
+@item message-syntax-checks
+@vindex message-syntax-checks
+If non-@code{nil}, Message will attempt to check the legality of the
+headers, as well as some other stuff, before posting. You can control
+the granularity of the check by adding or removing elements from this
+list. Legal elements are:
+
+@table @code
+@item subject-cmsg
+Check the subject for commands.
+@item sender
+@cindex Sender
+Insert a new @code{Sender} header if the @code{From} header looks odd.
+@item multiple-headers
+Check for the existence of multiple equal headers.
+@item sendsys
+@cindex sendsys
+Check for the existence of version and sendsys commands.
+@item message-id
+Check whether the @code{Message-ID} looks ok.
+@item from
+Check whether the @code{From} header seems nice.
+@item long-lines
+@cindex long lines
+Check for too long lines.
+@item control-chars
+Check for illegal characters.
+@item size
+Check for excessive size.
+@item new-text
+Check whether there is any new text in the messages.
+@item signature
+Check the length of the signature.
+@item approved
+@cindex approved
+Check whether the article has an @code{Approved} header, which is
+something only moderators should include.
+@item empty
+Check whether the article is empty.
+@item empty-headers
+Check whether any of the headers are empty.
+@item existing-newsgroups
+Check whether the newsgroups mentioned in the @code{Newsgroups} and
+@code{Followup-To} headers exist.
+@item valid-newsgroups
+Check whether the @code{Newsgroups} and @code{Followup-to} headers
+are valid syntactically.
+@item repeated-newsgroups
+Check whether the @code{Newsgroups} and @code{Followup-to} headers
+contains repeated group names.
+@item shorten-followup-to
+Check whether to add a @code{Followup-to} header to shorten the number
+of groups to post to.
+@end table
+
+All these conditions are checked by default.
+
+@item message-ignored-news-headers
+@vindex message-ignored-news-headers
+Regexp of headers to be removed before posting. The default is@*
+@samp{^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:}.
+
+@item message-default-news-headers
+@vindex message-default-news-headers
+This string is inserted at the end of the headers in all message
+buffers that are initialized as news.
+
+@end table
+
+
+@node News Variables
+@section News Variables
+
+@table @code
+@item message-send-news-function
+@vindex message-send-news-function
+Function used to send the current buffer as news. The default is
+@code{message-send-news}.
+
+@item message-post-method
+@vindex message-post-method
+Method used for posting a prepared news message.
+
+@end table
+
+
+@node Various Message Variables
+@section Various Message Variables
+
+@table @code
+@item message-signature-separator
+@vindex message-signature-separator
+Regexp matching the signature separator. It is @samp{^-- *$} by
+default.
+
+@item mail-header-separator
+@vindex mail-header-separator
+String used to separate the headers from the body. It is @samp{--text
+follows this line--} by default.
+
+@item message-directory
+@vindex message-directory
+Directory used by many mailey things. The default is @file{~/Mail/}.
+
+@item message-autosave-directory
+@vindex message-autosave-directory
+Directory where message buffers will be autosaved to.
+
+@item message-signature-setup-hook
+@vindex message-signature-setup-hook
+Hook run when initializing the message buffer. It is run after the
+headers have been inserted but before the signature has been inserted.
+
+@item message-setup-hook
+@vindex message-setup-hook
+Hook run as the last thing when the message buffer has been initialized,
+but before yanked text is inserted.
+
+@item message-header-setup-hook
+@vindex message-header-setup-hook
+Hook called narrowed to the headers after initializing the headers.
+
+For instance, if you're running Gnus and wish to insert a
+@samp{Mail-Copies-To} header in all your news articles and all messages
+you send to mailing lists, you could do something like the following:
+
+@lisp
+(defun my-message-header-setup-hook ()
+ (let ((group (or gnus-newsgroup-name "")))
+ (when (or (message-fetch-field "newsgroups")
+ (gnus-group-find-parameter group 'to-address)
+ (gnus-group-find-parameter group 'to-list))
+ (insert "Mail-Copies-To: never\n"))))
+
+(add-hook 'message-header-setup-hook 'my-message-header-setup-hook)
+@end lisp
+
+@item message-send-hook
+@vindex message-send-hook
+Hook run before sending messages.
+
+If you want to add certain headers before sending, you can use the
+@code{message-add-header} function in this hook. For instance:
+@findex message-add-header
+
+@lisp
+(add-hook 'message-send-hook 'my-message-add-content)
+(defun my-message-add-content ()
+ (message-add-header
+ "Mime-Version: 1.0"
+ "Content-Type: text/plain"
+ "Content-Transfer-Encoding: 7bit"))
+@end lisp
+
+This function won't add the header if the header is already present.
+
+@item message-send-mail-hook
+@vindex message-send-mail-hook
+Hook run before sending mail messages.
+
+@item message-send-news-hook
+@vindex message-send-news-hook
+Hook run before sending news messages.
+
+@item message-sent-hook
+@vindex message-sent-hook
+Hook run after sending messages.
+
+@item message-mode-syntax-table
+@vindex message-mode-syntax-table
+Syntax table used in message mode buffers.
+
+@item message-send-method-alist
+@vindex message-send-method-alist
+
+Alist of ways to send outgoing messages. Each element has the form
+
+@lisp
+(TYPE PREDICATE FUNCTION)
+@end lisp
+
+@table @var
+@item type
+A symbol that names the method.
+
+@item predicate
+A function called without any parameters to determine whether the
+message is a message of type @var{type}.
+
+@item function
+A function to be called if @var{predicate} returns non-@code{nil}.
+@var{function} is called with one parameter -- the prefix.
+@end table
+
+@lisp
+((news message-news-p message-send-via-news)
+ (mail message-mail-p message-send-via-mail))
+@end lisp
+
+
+
+@end table
+
+
+
+@node Sending Variables
+@section Sending Variables
+
+@table @code
+
+@item message-fcc-handler-function
+@vindex message-fcc-handler-function
+A function called to save outgoing articles. This function will be
+called with the name of the file to store the article in. The default
+function is @code{rmail-output} which saves in Unix mailbox format.
+
+@item message-courtesy-message
+@vindex message-courtesy-message
+When sending combined messages, this string is inserted at the start of
+the mailed copy. If the string contains the format spec @samp{%s}, the
+newsgroups the article has been posted to will be inserted there. If
+this variable is @code{nil}, no such courtesy message will be added.
+The default value is @samp{"The following message is a courtesy copy of
+an article\nthat has been posted to %s as well.\n\n"}.
+
+@end table
+
+
+@node Message Buffers
+@section Message Buffers
+
+Message will generate new buffers with unique buffer names when you
+request a message buffer. When you send the message, the buffer isn't
+normally killed off. Its name is changed and a certain number of old
+message buffers are kept alive.
+
+@table @code
+@item message-generate-new-buffers
+@vindex message-generate-new-buffers
+If non-@code{nil}, generate new buffers. The default is @code{t}. If
+this is a function, call that function with three parameters: The type,
+the to address and the group name. (Any of these may be @code{nil}.)
+The function should return the new buffer name.
+
+@item message-max-buffers
+@vindex message-max-buffers
+This variable says how many old message buffers to keep. If there are
+more message buffers than this, the oldest buffer will be killed. The
+default is 10. If this variable is @code{nil}, no old message buffers
+will ever be killed.
+
+@item message-send-rename-function
+@vindex message-send-rename-function
+After sending a message, the buffer is renamed from, for instance,
+@samp{*reply to Lars*} to @samp{*sent reply to Lars*}. If you don't
+like this, set this variable to a function that renames the buffer in a
+manner you like. If you don't want to rename the buffer at all, you can
+say:
+
+@lisp
+(setq message-send-rename-function 'ignore)
+@end lisp
+
+@item message-kill-buffer-on-exit
+@findex message-kill-buffer-on-exit
+If non-@code{nil}, kill the buffer immediately on exit.
+
+@end table
+
+
+@node Message Actions
+@section Message Actions
+
+When Message is being used from a news/mail reader, the reader is likely
+to want to perform some task after the message has been sent. Perhaps
+return to the previous window configuration or mark an article as
+replied.
+
+@vindex message-kill-actions
+@vindex message-postpone-actions
+@vindex message-exit-actions
+@vindex message-send-actions
+The user may exit from the message buffer in various ways. The most
+common is @kbd{C-c C-c}, which sends the message and exits. Other
+possibilities are @kbd{C-c C-s} which just sends the message, @kbd{C-c
+C-d} which postpones the message editing and buries the message buffer,
+and @kbd{C-c C-k} which kills the message buffer. Each of these actions
+have lists associated with them that contains actions to be executed:
+@code{message-send-actions}, @code{message-exit-actions},
+@code{message-postpone-actions}, and @code{message-kill-actions}.
+
+Message provides a function to interface with these lists:
+@code{message-add-action}. The first parameter is the action to be
+added, and the rest of the arguments are which lists to add this action
+to. Here's an example from Gnus:
+
+@lisp
+ (message-add-action
+ `(set-window-configuration ,(current-window-configuration))
+ 'exit 'postpone 'kill)
+@end lisp
+
+This restores the Gnus window configuration when the message buffer is
+killed, postponed or exited.
+
+An @dfn{action} can be either: a normal function, or a list where the
+@code{car} is a function and the @code{cdr} is the list of arguments, or
+a form to be @code{eval}ed.
+
+
+@node Compatibility
+@chapter Compatibility
+@cindex compatibility
+
+Message uses virtually only its own variables---older @code{mail-}
+variables aren't consulted. To force Message to take those variables
+into account, you can put the following in your @code{.emacs} file:
+
+@lisp
+(require 'messcompat)
+@end lisp
+
+This will initialize many Message variables from the values in the
+corresponding mail variables.
+
+
+
+@node Index
+@chapter Index
+@printindex cp
+
+@node Key Index
+@chapter Key Index
+@printindex ky
+
+@summarycontents
+@contents
+@bye
+
+@c End:
--- /dev/null
+\gnuscleardoublepage
+
+\pagestyle{gnusindex}
+
+\renewcommand\indexname{Key Index}
+\renewcommand{\gnuschaptername}{Key Index}
+\input{gnus.kind}
+\gnuscleardoublepage
+
+\renewcommand\indexname{Function and Variable Index}
+\renewcommand{\gnuschaptername}{Function and Variable Index}
+\input{gnus.gind}
+\gnuscleardoublepage
+\thispagestyle{empty}
+
+\renewcommand\indexname{Concept Index}
+\renewcommand{\gnuschaptername}{Concept Index}
+\input{gnus.cind}
+
+\mbox{}
+%\thispagestyle{empty}\mbox{}\clearpage\thispagestyle{empty}\mbox{}\clearpage
+\ifodd\count0\else\thispagestyle{empty}\clearpage\fi
+\mbox{}
+\thispagestyle{empty}
+\vfill
+
+\begin{picture}(10,10)
+\put(90,-10){\makebox(0,0)[tr]{\epsfig{figure=tmp/larsi.ps,height=3cm}}}
+\end{picture}
+
+\hspace*{4cm}\parbox[t]{10cm}{
+This manual was written by Lars Magne Ingebrigtsen (b. 1968) who
+resides in Oslo, Norway and poses as a student, but doesn't get much
+studying done, for some strange reason or other. When not worshipping
+at the altar of Emacs, he can often be found slouching on his couch
+reading while bopping his head gently to some obscure music. He does
+not have a cat.
+
+Graphics by Luis Fernandes. Set in Bembo and Futura.
+}
+
+\clearpage
+\mbox{}
+\thispagestyle{empty}
+\begin{picture}(500,500)(0,0)
+\put(-35,325){\makebox(480,350)[tr]{\epsfig{figure=tmp/new-herd-section.ps}}}
+\end{picture}
+
+\end{document}
--- /dev/null
+% Reference Card for (ding) Gnus, 3 twocolumn pages.
+% To be processed with latex 2.09
+\def\Guide{Card}\def\guide{card}
+\def\logoscale{0.25}
+\def\sec{\section*}
+\def\subsec{\subsection*}
+\def\subsubsec{\subsubsection*}
+\documentstyle{article}
+\textwidth 7.26in \textheight 10in \topmargin -1.0in
+% the same settings work for A4, although there is a bit of space at the
+% top and bottom of the page.
+\oddsidemargin -0.5in \evensidemargin -0.5in
+\begin{document}
+\twocolumn\scriptsize\pagestyle{empty}
+\input{gnusref}
+
+% page 1, left column
+\Title
+\par
+\vspace{0.5\baselineskip}
+\Logo{refcard}
+\vspace*{\fill}
+\GroupLevels
+\GroupMode
+\pagebreak
+
+% page 1, right column
+\Notes
+\vspace*{\fill}
+\GroupCommands
+\pagebreak
+
+% page 2, left column
+\SummaryMode
+\Asubmap
+\Bsubmap
+\Gsubmap
+\Hsubmap
+\Tsubmap
+\pagebreak
+
+% page 2, right column
+\Msubmap
+\Marks
+\pagebreak
+
+% page 3
+\Osubmap
+\Ssubmap
+\Xsubmap
+\Vsubmap
+\SortSummary
+\Wsubmap
+\Zsubmap
+\ArticleMode
+\ServerMode
+
+% page 4
+\BrowseServer
+\pagebreak
+\onecolumn
+\vspace*{\fill}
+\CopyRight
+
+\end{document}
--- /dev/null
+\input texinfo.tex
+
+@c %**start of header
+@setfilename widget
+@settitle The Emacs Widget Library
+@iftex
+@afourpaper
+@headings double
+@end iftex
+@c %**end of header
+
+@node Top, Introduction, (dir), (dir)
+@comment node-name, next, previous, up
+@top The Emacs Widget Library
+
+Version: 1.82
+
+@menu
+* Introduction::
+* User Interface::
+* Programming Example::
+* Setting Up the Buffer::
+* Basic Types::
+* Sexp Types::
+* Widget Properties::
+* Defining New Widgets::
+* Widget Wishlist.::
+@end menu
+
+@node Introduction, User Interface, Top, Top
+@comment node-name, next, previous, up
+@section Introduction
+
+Most graphical user interface toolkits, such as Motif and XView, provide
+a number of standard user interface controls (sometimes known as
+`widgets' or `gadgets'). Emacs doesn't really support anything like
+this, except for an incredible powerful text ``widget''. On the other
+hand, Emacs does provide the necessary primitives to implement many
+other widgets within a text buffer. The @code{widget} package
+simplifies this task.
+
+The basic widgets are:
+
+@table @code
+@item link
+Areas of text with an associated action. Intended for hypertext links
+embedded in text.
+@item push-button
+Like link, but intended for stand-alone buttons.
+@item editable-field
+An editable text field. It can be either variable or fixed length.
+@item menu-choice
+Allows the user to choose one of multiple options from a menu, each
+option is itself a widget. Only the selected option will be visible in
+the buffer.
+@item radio-button-choice
+Allows the user to choose one of multiple options by pushing radio
+buttons. The options are implemented as widgets. All options will be
+visible in the buffer.
+@item item
+A simple constant widget intended to be used in the @code{menu-choice} and
+@code{radio-button-choice} widgets.
+@item choice-item
+An button item only intended for use in choices. When pushed, the user
+will be asked to select another option from the choice widget.
+@item toggle
+A simple @samp{on}/@samp{off} switch.
+@item checkbox
+A checkbox (@samp{[ ]}/@samp{[X]}).
+@item editable-list
+Create an editable list. The user can insert or delete items in the
+list. Each list item is itself a widget.
+@end table
+
+Now of what possible use can support for widgets be in a text editor?
+I'm glad you asked. The answer is that widgets are useful for
+implementing forms. A @dfn{form} in emacs is a buffer where the user is
+supposed to fill out a number of fields, each of which has a specific
+meaning. The user is not supposed to change or delete any of the text
+between the fields. Examples of forms in Emacs are the @file{forms}
+package (of course), the customize buffers, the mail and news compose
+modes, and the @sc{html} form support in the @file{w3} browser.
+
+The advantages for a programmer of using the @code{widget} package to
+implement forms are:
+
+@enumerate
+@item
+More complex field than just editable text are supported.
+@item
+You can give the user immediate feedback if he enters invalid data in a
+text field, and sometimes prevent entering invalid data.
+@item
+You can have fixed sized fields, thus allowing multiple field to be
+lined up in columns.
+@item
+It is simple to query or set the value of a field.
+@item
+Editing happens in buffer, not in the mini-buffer.
+@item
+Packages using the library get a uniform look, making them easier for
+the user to learn.
+@item
+As support for embedded graphics improve, the widget library will
+extended to support it. This means that your code using the widget
+library will also use the new graphic features by automatic.
+@end enumerate
+
+In order to minimize the code that is loaded by users who does not
+create any widgets, the code has been split in two files:
+
+@table @file
+@item widget.el
+This will declare the user variables, define the function
+@code{widget-define}, and autoload the function @code{widget-create}.
+@item wid-edit.el
+Everything else is here, there is no reason to load it explicitly, as
+it will be autoloaded when needed.
+@end table
+
+@node User Interface, Programming Example, Introduction, Top
+@comment node-name, next, previous, up
+@section User Interface
+
+A form consist of read only text for documentation and some fields,
+where each the fields contain two parts, as tag and a value. The tags
+are used to identify the fields, so the documentation can refer to the
+foo field, meaning the field tagged with @samp{Foo}. Here is an example
+form:
+
+@example
+Here is some documentation.
+
+Name: @i{My Name} @strong{Choose}: This option
+Address: @i{Some Place
+In some City
+Some country.}
+
+See also @b{_other work_} for more information.
+
+Numbers: count to three below
+@b{[INS]} @b{[DEL]} @i{One}
+@b{[INS]} @b{[DEL]} @i{Eh, two?}
+@b{[INS]} @b{[DEL]} @i{Five!}
+@b{[INS]}
+
+Select multiple:
+
+@b{[X]} This
+@b{[ ]} That
+@b{[X]} Thus
+
+Select one:
+
+@b{(*)} One
+@b{( )} Another One.
+@b{( )} A Final One.
+
+@b{[Apply Form]} @b{[Reset Form]}
+@end example
+
+The top level widgets in is example are tagged @samp{Name},
+@samp{Choose}, @samp{Address}, @samp{_other work_}, @samp{Numbers},
+@samp{Select multiple}, @samp{Select one}, @samp{[Apply Form]}, and
+@samp{[Reset Form]}. There are basically two thing the user can do within
+a form, namely editing the editable text fields and activating the
+buttons.
+
+@subsection Editable Text Fields
+
+In the example, the value for the @samp{Name} is most likely displayed
+in an editable text field, and so are values for each of the members of
+the @samp{Numbers} list. All the normal Emacs editing operations are
+available for editing these fields. The only restriction is that each
+change you make must be contained within a single editable text field.
+For example, capitalizing all text from the middle of one field to the
+middle of another field is prohibited.
+
+Editing text fields are created by the @code{editable-field} widget.
+
+The editing text fields are highlighted with the
+@code{widget-field-face} face, making them easy to find.
+
+@deffn Face widget-field-face
+Face used for other editing fields.
+@end deffn
+
+@subsection Buttons
+
+Some portions of the buffer have an associated @dfn{action}, which can
+be @dfn{activated} by a standard key or mouse command. These portions
+are called @dfn{buttons}. The default commands for activating a button
+are:
+
+@table @kbd
+@item @key{RET}
+@deffn Command widget-button-press @var{pos} &optional @var{event}
+Activate the button at @var{pos}, defaulting to point.
+If point is not located on a button, activate the binding in
+@code{widget-global-map} (by default the global map).
+@end deffn
+
+@item mouse-2
+@deffn Command widget-button-click @var{event}
+Activate the button at the location of the mouse pointer. If the mouse
+pointer is located in an editable text field, activate the binding in
+@code{widget-global-map} (by default the global map).
+@end deffn
+@end table
+
+There are several different kind of buttons, all of which are present in
+the example:
+
+@table @emph
+@item The Option Field Tags.
+When you activate one of these buttons, you will be asked to choose
+between a number of different options. This is how you edit an option
+field. Option fields are created by the @code{menu-choice} widget. In
+the example, @samp{@b{Choose}} is an option field tag.
+@item The @samp{@b{[INS]}} and @samp{@b{[DEL]}} buttons.
+Activating these will insert or delete elements from a editable list.
+The list is created by the @code{editable-list} widget.
+@item Embedded Buttons.
+The @samp{@b{_other work_}} is an example of an embedded
+button. Embedded buttons are not associated with a fields, but can serve
+any purpose, such as implementing hypertext references. They are
+usually created by the @code{link} widget.
+@item The @samp{@b{[ ]}} and @samp{@b{[X]}} buttons.
+Activating one of these will convert it to the other. This is useful
+for implementing multiple-choice fields. You can create it wit
+@item The @samp{@b{( )}} and @samp{@b{(*)}} buttons.
+Only one radio button in a @code{radio-button-choice} widget can be selected at any
+time. When you push one of the unselected radio buttons, it will be
+selected and the previous selected radio button will become unselected.
+@item The @samp{@b{[Apply Form]}} @samp{@b{[Reset Form]}} buttons.
+These are explicit buttons made with the @code{push-button} widget. The main
+difference from the @code{link} widget is that the buttons are will be
+displayed as GUI buttons when possible.
+enough.
+@end table
+
+To make them easier to locate, buttons are emphasized in the buffer.
+
+@deffn Face widget-button-face
+Face used for buttons.
+@end deffn
+
+@defopt widget-mouse-face
+Face used for buttons when the mouse pointer is above it.
+@end defopt
+
+@subsection Navigation
+
+You can use all the normal Emacs commands to move around in a form
+buffer, plus you will have these additional commands:
+
+@table @kbd
+@item @key{TAB}
+@deffn Command widget-forward &optional count
+Move point @var{count} buttons or editing fields forward.
+@end deffn
+@item @key{M-TAB}
+@deffn Command widget-backward &optional count
+Move point @var{count} buttons or editing fields backward.
+@end deffn
+@end table
+
+@node Programming Example, Setting Up the Buffer, User Interface, Top
+@comment node-name, next, previous, up
+@section Programming Example
+
+Here is the code to implement the user interface example (see @ref{User
+Interface}).
+
+@lisp
+(require 'widget)
+
+(eval-when-compile
+ (require 'wid-edit))
+
+(defvar widget-example-repeat)
+
+(defun widget-example ()
+ "Create the widgets from the Widget manual."
+ (interactive)
+ (switch-to-buffer "*Widget Example*")
+ (kill-all-local-variables)
+ (make-local-variable 'widget-example-repeat)
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (widget-insert "Here is some documentation.\n\nName: ")
+ (widget-create 'editable-field
+ :size 13
+ "My Name")
+ (widget-create 'menu-choice
+ :tag "Choose"
+ :value "This"
+ :help-echo "Choose me, please!"
+ :notify (lambda (widget &rest ignore)
+ (message "%s is a good choice!"
+ (widget-value widget)))
+ '(item :tag "This option" :value "This")
+ '(choice-item "That option")
+ '(editable-field :menu-tag "No option" "Thus option"))
+ (widget-insert "Address: ")
+ (widget-create 'editable-field
+ "Some Place\nIn some City\nSome country.")
+ (widget-insert "\nSee also ")
+ (widget-create 'link
+ :notify (lambda (&rest ignore)
+ (widget-value-set widget-example-repeat
+ '("En" "To" "Tre"))
+ (widget-setup))
+ "other work")
+ (widget-insert " for more information.\n\nNumbers: count to three below\n")
+ (setq widget-example-repeat
+ (widget-create 'editable-list
+ :entry-format "%i %d %v"
+ :notify (lambda (widget &rest ignore)
+ (let ((old (widget-get widget
+ ':example-length))
+ (new (length (widget-value widget))))
+ (unless (eq old new)
+ (widget-put widget ':example-length new)
+ (message "You can count to %d." new))))
+ :value '("One" "Eh, two?" "Five!")
+ '(editable-field :value "three")))
+ (widget-insert "\n\nSelect multiple:\n\n")
+ (widget-create 'checkbox t)
+ (widget-insert " This\n")
+ (widget-create 'checkbox nil)
+ (widget-insert " That\n")
+ (widget-create 'checkbox
+ :notify (lambda (&rest ignore) (message "Tickle"))
+ t)
+ (widget-insert " Thus\n\nSelect one:\n\n")
+ (widget-create 'radio-button-choice
+ :value "One"
+ :notify (lambda (widget &rest ignore)
+ (message "You selected %s"
+ (widget-value widget)))
+ '(item "One") '(item "Anthor One.") '(item "A Final One."))
+ (widget-insert "\n")
+ (widget-create 'push-button
+ :notify (lambda (&rest ignore)
+ (if (= (length (widget-value widget-example-repeat))
+ 3)
+ (message "Congratulation!")
+ (error "Three was the count!")))
+ "Apply Form")
+ (widget-insert " ")
+ (widget-create 'push-button
+ :notify (lambda (&rest ignore)
+ (widget-example))
+ "Reset Form")
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup))
+@end lisp
+
+@node Setting Up the Buffer, Basic Types, Programming Example, Top
+@comment node-name, next, previous, up
+@section Setting Up the Buffer
+
+Widgets are created with @code{widget-create}, which returns a
+@dfn{widget} object. This object can be queried and manipulated by
+other widget functions, until it is deleted with @code{widget-delete}.
+After the widgets have been created, @code{widget-setup} must be called
+to enable them.
+
+@defun widget-create type [ keyword argument ]@dots{}
+Create and return a widget of type @var{type}.
+The syntax for the @var{type} argument is described in @ref{Basic Types}.
+
+The keyword arguments can be used to overwrite the keyword arguments
+that are part of @var{type}.
+@end defun
+
+@defun widget-delete widget
+Delete @var{widget} and remove it from the buffer.
+@end defun
+
+@defun widget-setup
+Setup a buffer to support widgets.
+
+This should be called after creating all the widgets and before allowing
+the user to edit them.
+@refill
+@end defun
+
+If you want to insert text outside the widgets in the form, the
+recommended way to do that is with @code{widget-insert}.
+
+@defun widget-insert
+Insert the arguments, either strings or characters, at point.
+The inserted text will be read only.
+@end defun
+
+There is a standard widget keymap which you might find useful.
+
+@defvr Const widget-keymap
+A keymap with the global keymap as its parent.@*
+@key{TAB} and @kbd{C-@key{TAB}} are bound to @code{widget-forward} and
+@code{widget-backward}, respectively. @kbd{@key{RET}} and @kbd{mouse-2}
+are bound to @code{widget-button-press} and
+@code{widget-button-}.@refill
+@end defvr
+
+@defvar widget-global-map
+Keymap used by @code{widget-button-press} and @code{widget-button-click}
+when not on a button. By default this is @code{global-map}.
+@end defvar
+
+@node Basic Types, Sexp Types, Setting Up the Buffer, Top
+@comment node-name, next, previous, up
+@section Basic Types
+
+The syntax of a type specification is given below:
+
+@example
+NAME ::= (NAME [KEYWORD ARGUMENT]... ARGS)
+ | NAME
+@end example
+
+Where, @var{name} is a widget name, @var{keyword} is the name of a
+property, @var{argument} is the value of the property, and @var{args}
+are interpreted in a widget specific way.
+
+There following keyword arguments that apply to all widgets:
+
+@table @code
+@item :value
+The initial value for widgets of this type.
+
+@item :format
+This string will be inserted in the buffer when you create a widget.
+The following @samp{%} escapes are available:
+
+@table @samp
+@item %[
+@itemx %]
+The text inside will be marked as a button.
+
+@item %@{
+@itemx %@}
+The text inside will be displayed with the face specified by
+@code{:sample-face}.
+
+@item %v
+This will be replaces with the buffer representation of the widgets
+value. What this is depends on the widget type.
+
+@item %d
+Insert the string specified by @code{:doc} here.
+
+@item %h
+Like @samp{%d}, with the following modifications: If the documentation
+string is more than one line, it will add a button which will toggle
+between showing only the first line, and showing the full text.
+Furthermore, if there is no @code{:doc} property in the widget, it will
+instead examine the @code{:documentation-property} property. If it is a
+lambda expression, it will be called with the widget's value as an
+argument, and the result will be used as the documentation text.
+
+@item %t
+Insert the string specified by @code{:tag} here, or the @code{princ}
+representation of the value if there is no tag.
+
+@item %%
+Insert a literal @samp{%}.
+@end table
+
+@item :button-face
+Face used to highlight text inside %[ %] in the format.
+
+@item :doc
+The string inserted by the @samp{%d} escape in the format
+string.
+
+@item :tag
+The string inserted by the @samp{%t} escape in the format
+string.
+
+@item :tag-glyph
+Name of image to use instead of the string specified by `:tag' on
+Emacsen that supports it.
+
+@item :help-echo
+Message displayed whenever you move to the widget with either
+@code{widget-forward} or @code{widget-backward}.
+
+@item :indent
+An integer indicating the absolute number of spaces to indent children
+of this widget.
+
+@item :offset
+An integer indicating how many extra spaces to add to the widget's
+grandchildren compared to this widget.
+
+@item :extra-offset
+An integer indicating how many extra spaces to add to the widget's
+children compared to this widget.
+
+@item :notify
+A function called each time the widget or a nested widget is changed.
+The function is called with two or three arguments. The first argument
+is the widget itself, the second argument is the widget that was
+changed, and the third argument is the event leading to the change, if
+any.
+
+@item :menu-tag
+Tag used in the menu when the widget is used as an option in a
+@code{menu-choice} widget.
+
+@item :menu-tag-get
+Function used for finding the tag when the widget is used as an option
+in a @code{menu-choice} widget. By default, the tag used will be either the
+@code{:menu-tag} or @code{:tag} property if present, or the @code{princ}
+representation of the @code{:value} property if not.
+
+@item :match
+Should be a function called with two arguments, the widget and a value,
+and returning non-nil if the widget can represent the specified value.
+
+@item :validate
+A function which takes a widget as an argument, and return nil if the
+widgets current value is valid for the widget. Otherwise, it should
+return the widget containing the invalid data, and set that widgets
+@code{:error} property to a string explaining the error.
+
+@item :tab-order
+Specify the order in which widgets are traversed with
+@code{widget-forward} or @code{widget-backward}. This is only partially
+implemented.
+
+@enumerate a
+@item
+Widgets with tabbing order @code{-1} are ignored.
+
+@item
+(Unimplemented) When on a widget with tabbing order @var{n}, go to the
+next widget in the buffer with tabbing order @var{n+1} or @code{nil},
+whichever comes first.
+
+@item
+When on a widget with no tabbing order specified, go to the next widget
+in the buffer with a positive tabbing order, or @code{nil}
+@end enumerate
+
+@item :parent
+The parent of a nested widget (e.g. a @code{menu-choice} item or an
+element of a @code{editable-list} widget).
+
+@item :sibling-args
+This keyword is only used for members of a @code{radio-button-choice} or
+@code{checklist}. The value should be a list of extra keyword
+arguments, which will be used when creating the @code{radio-button} or
+@code{checkbox} associated with this item.
+
+@end table
+
+@deffn {User Option} widget-glyph-directory
+Directory where glyphs are found.
+Widget will look here for a file with the same name as specified for the
+image, with either a @samp{.xpm} (if supported) or @samp{.xbm} extension.
+@end deffn
+
+@deffn{User Option} widget-glyph-enable
+If non-nil, allow glyphs to appear on displayes where they are supported.
+@end deffn
+
+
+@menu
+* link::
+* url-link::
+* info-link::
+* push-button::
+* editable-field::
+* text::
+* menu-choice::
+* radio-button-choice::
+* item::
+* choice-item::
+* toggle::
+* checkbox::
+* checklist::
+* editable-list::
+@end menu
+
+@node link, url-link, Basic Types, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{link} Widget
+
+Syntax:
+
+@example
+TYPE ::= (link [KEYWORD ARGUMENT]... [ VALUE ])
+@end example
+
+The @var{value}, if present, is used to initialize the @code{:value}
+property. The value should be a string, which will be inserted in the
+buffer.
+
+@node url-link, info-link, link, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{url-link} Widget
+
+Syntax:
+
+@example
+TYPE ::= (url-link [KEYWORD ARGUMENT]... URL)
+@end example
+
+When this link is activated, the @sc{www} browser specified by
+@code{browse-url-browser-function} will be called with @var{url}.
+
+@node info-link, push-button, url-link, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{info-link} Widget
+
+Syntax:
+
+@example
+TYPE ::= (info-link [KEYWORD ARGUMENT]... ADDRESS)
+@end example
+
+When this link is activated, the build-in info browser is started on
+@var{address}.
+
+@node push-button, editable-field, info-link, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{push-button} Widget
+
+Syntax:
+
+@example
+TYPE ::= (push-button [KEYWORD ARGUMENT]... [ VALUE ])
+@end example
+
+The @var{value}, if present, is used to initialize the @code{:value}
+property. The value should be a string, which will be inserted in the
+buffer.
+
+The following extra properties are recognized.
+
+@table @code
+@item :text-format
+The format string used when the push button cannot be displayed
+graphically. There are two escapes, @code{%s}, which must be present
+exactly once, will be substituted with the tag, and @code{%%} will be
+substituted with a singe @samp{%}.
+@end table
+
+By default the tag will be shown in brackets.
+
+@node editable-field, text, push-button, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{editable-field} Widget
+
+Syntax:
+
+@example
+TYPE ::= (editable-field [KEYWORD ARGUMENT]... [ VALUE ])
+@end example
+
+The @var{value}, if present, is used to initialize the @code{:value}
+property. The value should be a string, which will be inserted in
+field. This widget will match all string values.
+
+The following extra properties are recognized.
+
+@table @code
+@item :size
+The width of the editable field.@*
+By default the field will reach to the end of the line.
+
+@item :value-face
+Face used for highlighting the editable field. Default is
+@code{widget-field-face}.
+
+@item :secret
+Character used to display the value. You can set this to e.g. @code{?*}
+if the field contains a password or other secret information. By
+default, the value is not secret.
+
+@item :valid-regexp
+By default the @code{:validate} function will match the content of the
+field with the value of this attribute. The default value is @code{""}
+which matches everything.
+
+@item :keymap
+Keymap used in the editable field. The default value is
+@code{widget-field-keymap}, which allows you to use all the normal
+editing commands, even if the buffers major mode supress some of them.
+Pressing return activates the function specified by @code{:activate}.
+
+@item :hide-front-space
+@itemx :hide-rear-space
+In order to keep track of the editable field, emacs places an invisible
+space character in front of the field, and for fixed sized fields also
+in the rear end of the field. For fields that extent to the end of the
+line, the terminating linefeed serves that purpose instead.
+
+Emacs will try to make the spaces intangible when it is safe to do so.
+Intangible means that the cursor motion commands will skip over the
+character as if it didn't exist. This is safe to do when the text
+preceding or following the widget cannot possible change during the
+lifetime of the @code{editable-field} widget. The preferred way to tell
+Emacs this, is to add text to the @code{:format} property around the
+value. For example @code{:format "Tag: %v "}.
+
+You can overwrite the internal safety check by setting the
+@code{:hide-front-space} or @code{:hide-rear-space} properties to
+non-nil. This is not recommended. For example, @emph{all} text that
+belongs to a widget (i.e. is created from its @code{:format} string) will
+change whenever the widget changes its value.
+
+@end table
+
+@node text, menu-choice, editable-field, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{text} Widget
+
+This is just like @code{editable-field}, but intended for multiline text
+fields. The default @code{:keymap} is @code{widget-text-keymap}, which
+does not rebind the return key.
+
+@node menu-choice, radio-button-choice, text, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{menu-choice} Widget
+
+Syntax:
+
+@example
+TYPE ::= (menu-choice [KEYWORD ARGUMENT]... TYPE ... )
+@end example
+
+The @var{type} arguments represents each possible choice. The widgets
+value of will be the value of the chosen @var{type} argument. This
+widget will match any value that matches at least one of the specified
+@var{type} arguments.
+
+@table @code
+@item :void
+Widget type used as a fallback when the value does not match any of the
+specified @var{type} arguments.
+
+@item :case-fold
+Set this to nil if you don't want to ignore case when prompting for a
+choice through the minibuffer.
+
+@item :children
+A list whose car is the widget representing the currently chosen type in
+the buffer.
+
+@item :choice
+The current chosen type
+
+@item :args
+The list of types.
+@end table
+
+@node radio-button-choice, item, menu-choice, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{radio-button-choice} Widget
+
+Syntax:
+
+@example
+TYPE ::= (radio-button-choice [KEYWORD ARGUMENT]... TYPE ... )
+@end example
+
+The @var{type} arguments represents each possible choice. The widgets
+value of will be the value of the chosen @var{type} argument. This
+widget will match any value that matches at least one of the specified
+@var{type} arguments.
+
+The following extra properties are recognized.
+
+@table @code
+@item :entry-format
+This string will be inserted for each entry in the list.
+The following @samp{%} escapes are available:
+@table @samp
+@item %v
+Replaced with the buffer representation of the @var{type} widget.
+@item %b
+Replace with the radio button.
+@item %%
+Insert a literal @samp{%}.
+@end table
+
+@item button-args
+A list of keywords to pass to the radio buttons. Useful for setting
+e.g. the @samp{:help-echo} for each button.
+
+@item :buttons
+The widgets representing the radio buttons.
+
+@item :children
+The widgets representing each type.
+
+@item :choice
+The current chosen type
+
+@item :args
+The list of types.
+@end table
+
+You can add extra radio button items to a @code{radio-button-choice}
+widget after it has been created with the function
+@code{widget-radio-add-item}.
+
+@defun widget-radio-add-item widget type
+Add to @code{radio-button-choice} widget @var{widget} a new radio button item of type
+@var{type}.
+@end defun
+
+Please note that such items added after the @code{radio-button-choice}
+widget has been created will @strong{not} be properly destructed when
+you call @code{widget-delete}.
+
+@node item, choice-item, radio-button-choice, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{item} Widget
+
+Syntax:
+
+@example
+ITEM ::= (item [KEYWORD ARGUMENT]... VALUE)
+@end example
+
+The @var{value}, if present, is used to initialize the @code{:value}
+property. The value should be a string, which will be inserted in the
+buffer. This widget will only match the specified value.
+
+@node choice-item, toggle, item, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{choice-item} Widget
+
+Syntax:
+
+@example
+ITEM ::= (choice-item [KEYWORD ARGUMENT]... VALUE)
+@end example
+
+The @var{value}, if present, is used to initialize the @code{:value}
+property. The value should be a string, which will be inserted in the
+buffer as a button. Activating the button of a @code{choice-item} is
+equivalent to activating the parent widget. This widget will only match
+the specified value.
+
+@node toggle, checkbox, choice-item, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{toggle} Widget
+
+Syntax:
+
+@example
+TYPE ::= (toggle [KEYWORD ARGUMENT]...)
+@end example
+
+The widget has two possible states, `on' and `off', which corresponds to
+a @code{t} or @code{nil} value.
+
+The following extra properties are recognized.
+
+@table @code
+@item :on
+String representing the `on' state. By default the string @samp{on}.
+@item :off
+String representing the `off' state. By default the string @samp{off}.
+@item :on-glyph
+Name of a glyph to be used instead of the `:on' text string, on emacsen
+that supports it.
+@item :off-glyph
+Name of a glyph to be used instead of the `:off' text string, on emacsen
+that supports it.
+@end table
+
+@node checkbox, checklist, toggle, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{checkbox} Widget
+
+The widget has two possible states, `selected' and `unselected', which
+corresponds to a @code{t} or @code{nil} value.
+
+Syntax:
+
+@example
+TYPE ::= (checkbox [KEYWORD ARGUMENT]...)
+@end example
+
+@node checklist, editable-list, checkbox, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{checklist} Widget
+
+Syntax:
+
+@example
+TYPE ::= (checklist [KEYWORD ARGUMENT]... TYPE ... )
+@end example
+
+The @var{type} arguments represents each checklist item. The widgets
+value of will be a list containing the value of each ticked @var{type}
+argument. The checklist widget will match a list whose elements all
+matches at least one of the specified @var{type} arguments.
+
+The following extra properties are recognized.
+
+@table @code
+@item :entry-format
+This string will be inserted for each entry in the list.
+The following @samp{%} escapes are available:
+@table @samp
+@item %v
+Replaced with the buffer representation of the @var{type} widget.
+@item %b
+Replace with the checkbox.
+@item %%
+Insert a literal @samp{%}.
+@end table
+
+@item button-args
+A list of keywords to pass to the checkboxes. Useful for setting
+e.g. the @samp{:help-echo} for each checkbox.
+
+@item :buttons
+The widgets representing the checkboxes.
+
+@item :children
+The widgets representing each type.
+
+@item :args
+The list of types.
+@end table
+
+@node editable-list, , checklist, Basic Types
+@comment node-name, next, previous, up
+@subsection The @code{editable-list} Widget
+
+Syntax:
+
+@example
+TYPE ::= (editable-list [KEYWORD ARGUMENT]... TYPE)
+@end example
+
+The value is a list, where each member represent one widget of type
+@var{type}.
+
+The following extra properties are recognized.
+
+@table @code
+@item :entry-format
+This string will be inserted for each entry in the list.
+The following @samp{%} escapes are available:
+@table @samp
+@item %v
+This will be replaced with the buffer representation of the @var{type}
+widget.
+@item %i
+Insert the @b{[INS]} button.
+@item %d
+Insert the @b{[DEL]} button.
+@item %%
+Insert a literal @samp{%}.
+@end table
+
+@item :insert-button-args
+A list of keyword arguments to pass to the insert buttons.
+
+@item :delete-button-args
+A list of keyword arguments to pass to the delete buttons.
+
+@item :append-button-args
+A list of keyword arguments to pass to the trailing insert button.
+
+
+@item :buttons
+The widgets representing the insert and delete buttons.
+
+@item :children
+The widgets representing the elements of the list.
+
+@item :args
+List whose car is the type of the list elements.
+
+@end table
+
+@node Sexp Types, Widget Properties, Basic Types, Top
+@comment
+@section Sexp Types
+
+A number of widgets for editing s-expressions (lisp types) are also
+available. These basically fall in three categories: @dfn{atoms},
+@dfn{composite types}, and @dfn{generic}.
+
+@menu
+* generic::
+* atoms::
+* composite::
+@end menu
+
+@node generic, atoms, Sexp Types, Sexp Types
+@comment node-name, next, previous, up
+@subsection The Generic Widget.
+
+The @code{const} and @code{sexp} widgets can contain any lisp
+expression. In the case of the @code{const} widget the user is
+prohibited from editing edit it, which is mainly useful as a component
+of one of the composite widgets.
+
+The syntax for the generic widgets is
+
+@example
+TYPE ::= (const [KEYWORD ARGUMENT]... [ VALUE ])
+@end example
+
+The @var{value}, if present, is used to initialize the @code{:value}
+property and can be any s-expression.
+
+@deffn Widget const
+This will display any valid s-expression in an immutable part of the
+buffer.
+@end deffn
+
+@deffn Widget sexp
+This will allow you to edit any valid s-expression in an editable buffer
+field.
+
+The @code{sexp} widget takes the same keyword arguments as the
+@code{editable-field} widget.
+@end deffn
+
+@node atoms, composite, generic, Sexp Types
+@comment node-name, next, previous, up
+@subsection Atomic Sexp Widgets.
+
+The atoms are s-expressions that does not consist of other
+s-expressions. A string is an atom, while a list is a composite type.
+You can edit the value of an atom with the following widgets.
+
+The syntax for all the atoms are
+
+@example
+TYPE ::= (NAME [KEYWORD ARGUMENT]... [ VALUE ])
+@end example
+
+The @var{value}, if present, is used to initialize the @code{:value}
+property and must be an expression of the same type as the widget.
+I.e. the string widget can only be initialized with a string.
+
+All the atom widgets take the same keyword arguments as the @code{editable-field}
+widget.
+
+@deffn Widget string
+Allows you to edit a string in an editable field.
+@end deffn
+
+@deffn Widget file
+Allows you to edit a file name in an editable field. You you activate
+the tag button, you can edit the file name in the mini-buffer with
+completion.
+
+Keywords:
+@table @code
+@item :must-match
+If this is set to non-nil, only existing file names will be allowed in
+the minibuffer.
+@end table
+@end deffn
+
+@deffn Widget directory
+Allows you to edit a directory name in an editable field.
+Similar to the @code{file} widget.
+@end deffn
+
+@deffn Widget symbol
+Allows you to edit a lisp symbol in an editable field.
+@end deffn
+
+@deffn Widget integer
+Allows you to edit an integer in an editable field.
+@end deffn
+
+@deffn Widget number
+Allows you to edit a number in an editable field.
+@end deffn
+
+@deffn Widget boolean
+Allows you to edit a boolean. In lisp this means a variable which is
+either nil meaning false, or non-nil meaning true.
+@end deffn
+
+
+@node composite, , atoms, Sexp Types
+@comment node-name, next, previous, up
+@subsection Composite Sexp Widgets.
+
+The syntax for the composite are
+
+@example
+TYPE ::= (NAME [KEYWORD ARGUMENT]... COMPONENT...)
+@end example
+
+Where each @var{component} must be a widget type. Each component widget
+will be displayed in the buffer, and be editable to the user.
+
+@deffn Widget cons
+The value of a @code{cons} widget is a cons-cell where the car is the
+value of the first component and the cdr is the value of the second
+component. There must be exactly two components.
+@end deffn
+
+@deffn Widget lisp
+The value of a @code{lisp} widget is a list containing the value of
+each of its component.
+@end deffn
+
+@deffn Widget vector
+The value of a @code{vector} widget is a vector containing the value of
+each of its component.
+@end deffn
+
+The above suffice for specifying fixed size lists and vectors. To get
+variable length lists and vectors, you can use a @code{choice},
+@code{set} or @code{repeat} widgets together with the @code{:inline}
+keywords. If any component of a composite widget has the @code{:inline}
+keyword set, its value must be a list which will then be spliced into
+the composite. For example, to specify a list whose first element must
+be a file name, and whose remaining arguments should either by the
+symbol @code{t} or two files, you can use the following widget
+specification:
+
+@example
+(list file
+ (choice (const t)
+ (list :inline t
+ :value ("foo" "bar")
+ string string)))
+@end example
+
+The value of a widget of this type will either have the form
+@samp{(file t)} or @code{(file string string)}.
+
+This concept of inline is probably hard to understand. It was certainly
+hard to implement so instead of confuse you more by trying to explain it
+here, I'll just suggest you meditate over it for a while.
+
+@deffn Widget choice
+Allows you to edit a sexp which may have one of fixed set of types. It
+is currently implemented with the @code{choice-menu} basic widget, and
+has a similar syntax.
+@end deffn
+
+@deffn Widget set
+Allows you to specify a type which must be a list whose elements all
+belong to given set. The elements of the list is not significant. This
+is implemented on top of the @code{checklist} basic widget, and has a
+similar syntax.
+@end deffn
+
+@deffn Widget repeat
+Allows you to specify a variable length list whose members are all of
+the same type. Implemented on top of the `editable-list' basic widget,
+and has a similar syntax.
+@end deffn
+
+@node Widget Properties, Defining New Widgets, Sexp Types, Top
+@comment node-name, next, previous, up
+@section Properties
+
+You can examine or set the value of a widget by using the widget object
+that was returned by @code{widget-create}.
+
+@defun widget-value widget
+Return the current value contained in @var{widget}.
+It is an error to call this function on an uninitialized widget.
+@end defun
+
+@defun widget-value-set widget value
+Set the value contained in @var{widget} to @var{value}.
+It is an error to call this function with an invalid @var{value}.
+@end defun
+
+@strong{Important:} You @emph{must} call @code{widget-setup} after
+modifying the value of a widget before the user is allowed to edit the
+widget again. It is enough to call @code{widget-setup} once if you
+modify multiple widgets. This is currently only necessary if the widget
+contains an editing field, but may be necessary for other widgets in the
+future.
+
+If your application needs to associate some information with the widget
+objects, for example a reference to the item being edited, it can be
+done with @code{widget-put} and @code{widget-get}. The property names
+must begin with a @samp{:}.
+
+@defun widget-put widget property value
+In @var{widget} set @var{property} to @var{value}.
+@var{property} should be a symbol, while @var{value} can be anything.
+@end defun
+
+@defun widget-get widget property
+In @var{widget} return the value for @var{property}.
+@var{property} should be a symbol, the value is what was last set by
+@code{widget-put} for @var{property}.
+@end defun
+
+@defun widget-member widget property
+Non-nil if @var{widget} has a value (even nil) for property @var{property}.
+@end defun
+
+Occasionally it can be useful to know which kind of widget you have,
+i.e. the name of the widget type you gave when the widget was created.
+
+@defun widget-type widget
+Return the name of @var{widget}, a symbol.
+@end defun
+
+Widgets can be in two states: active, which means they are modifiable by
+the user, or inactive, which means they cannot be modified by the user.
+You can query or set the state with the following code:
+
+@lisp
+;; Examine if @var{widget} is active or not.
+(if (widget-apply @var{widget} :active)
+ (message "Widget is active.")
+ (message "Widget is inactive.")
+
+;; Make @var{widget} inactive.
+(widget-apply @var{widget} :deactivate)
+
+;; Make @var{widget} active.
+(widget-apply @var{widget} :activate)
+@end lisp
+
+A widget is inactive if itself, or any of its ancestors (found by
+following the @code{:parent} link) have been deactivated. To make sure
+a widget is really active, you must therefore activate both itself, and
+all its ancestors.
+
+@lisp
+(while widget
+ (widget-apply widget :activate)
+ (setq widget (widget-get widget :parent)))
+@end lisp
+
+You can check if a widget has been made inactive by examining the value
+of @code{:inactive} keyword. If this is non-nil, the widget itself has
+been deactivated. This is different from using the @code{:active}
+keyword, in that the later tell you if the widget @strong{or} any of its
+ancestors have been deactivated. Do not attempt to set the
+@code{:inactive} keyword directly. Use the @code{:activate}
+@code{:deactivated} keywords instead.
+
+
+@node Defining New Widgets, Widget Wishlist., Widget Properties, Top
+@comment node-name, next, previous, up
+@section Defining New Widgets
+
+You can define specialized widgets with @code{define-widget}. It allows
+you to create a shorthand for more complex widgets, including specifying
+component widgets and default new default values for the keyword
+arguments.
+
+@defun widget-define name class doc &rest args
+Define a new widget type named @var{name} from @code{class}.
+
+@var{name} and class should both be symbols, @code{class} should be one
+of the existing widget types.
+
+The third argument @var{DOC} is a documentation string for the widget.
+
+After the new widget has been defined, the following two calls will
+create identical widgets:
+
+@itemize @bullet
+@item
+@lisp
+(widget-create @var{name})
+@end lisp
+
+@item
+@lisp
+(apply widget-create @var{class} @var{args})
+@end lisp
+@end itemize
+
+@end defun
+
+Using @code{widget-define} does just store the definition of the widget
+type in the @code{widget-type} property of @var{name}, which is what
+@code{widget-create} uses.
+
+If you just want to specify defaults for keywords with no complex
+conversions, you can use @code{identity} as your conversion function.
+
+The following additional keyword arguments are useful when defining new
+widgets:
+@table @code
+@item :convert-widget
+Function to convert a widget type before creating a widget of that
+type. It takes a widget type as an argument, and returns the converted
+widget type. When a widget is created, this function is called for the
+widget type and all the widgets parent types, most derived first.
+
+@item :value-to-internal
+Function to convert the value to the internal format. The function
+takes two arguments, a widget and an external value, and returns the
+internal value. The function is called on the present @code{:value}
+when the widget is created, and on any value set later with
+@code{widget-value-set}.
+
+@item :value-to-external
+Function to convert the value to the external format. The function
+takes two arguments, a widget and an internal value, and returns the
+internal value. The function is called on the present @code{:value}
+when the widget is created, and on any value set later with
+@code{widget-value-set}.
+
+@item :create
+Function to create a widget from scratch. The function takes one
+argument, a widget type, and create a widget of that type, insert it in
+the buffer, and return a widget object.
+
+@item :delete
+Function to delete a widget. The function takes one argument, a widget,
+and should remove all traces of the widget from the buffer.
+
+@item :value-create
+Function to expand the @samp{%v} escape in the format string. It will
+be called with the widget as its argument. Should
+insert a representation of the widgets value in the buffer.
+
+@item :value-delete
+Should remove the representation of the widgets value from the buffer.
+It will be called with the widget as its argument. It doesn't have to
+remove the text, but it should release markers and delete nested widgets
+if such has been used.
+
+@item :format-handler
+Function to handle unknown @samp{%} escapes in the format string. It
+will be called with the widget and the escape character as arguments.
+You can set this to allow your widget to handle non-standard escapes.
+
+You should end up calling @code{widget-default-format-handler} to handle
+unknown escape sequences, which will handle the @samp{%h} and any future
+escape sequences, as well as give an error for unknown escapes.
+@end table
+
+If you want to define a new widget from scratch, use the @code{default}
+widget as its base.
+
+@deffn Widget default [ keyword argument ]
+Widget used as a base for other widgets.
+
+It provides most of the functionality that is referred to as ``by
+default'' in this text.
+@end deffn
+
+@node Widget Wishlist., , Defining New Widgets, Top
+@comment node-name, next, previous, up
+@section Wishlist.
+
+@itemize @bullet
+@item
+It should be possible to add or remove items from a list with @kbd{C-k}
+and @kbd{C-o} (suggested by @sc{rms}).
+
+@item
+The @samp{[INS]} and @samp{[DEL]} buttons should be replaced by a single
+dash (@samp{-}). The dash should be a button that, when activated, ask
+whether you want to add or delete an item (@sc{rms} wanted to git rid of
+the ugly buttons, the dash is my idea).
+
+@item
+Widgets such as @code{file} and @code{symbol} should prompt with completion.
+
+@item
+The @code{menu-choice} tag should be prettier, something like the abbreviated
+menus in Open Look.
+
+@item
+The functions used in many widgets, like
+@code{widget-item-convert-widget}, should not have names that are
+specific to the first widget where I happended to use them.
+
+@item
+Flag to make @code{widget-move} skip a specified button.
+
+@item
+Document `helper' functions for defining new widgets.
+
+@item
+Activate the item this is below the mouse when the button is
+released, not the item this is below the mouse when the button is
+pressed. Dired and grep gets this right. Give feedback if possible.
+
+@item
+Use @samp{@@deffn Widget} to document widgets.
+
+@item
+Document global keywords in one place.
+
+Document keywords particular to a specific widget in the widget
+definition.
+
+Document the `default' widget first.
+
+Split, when needed, keywords into those useful for normal
+customization, those primarily useful when deriving, and those who
+represent runtime information.
+
+@item
+Figure out terminology and @sc{api} for the class/type/object/super
+stuff.
+
+Perhaps the correct model is delegation?
+
+@item
+Document @code{widget-browse}.
+
+@item
+Make indentation work with glyphs and propertional fonts.
+
+@item
+Add object and class hierarchies to the browser.
+
+@end itemize
+
+@contents
+@bye
projects / elisp / gnus.git- / commitdiff