aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKatsumi Yamaoka2010-08-31 23:55:50 +0000
committerKatsumi Yamaoka2010-08-31 23:55:50 +0000
commitc4d82de839ead8d8b534ad11d14edc11d1ddbdb4 (patch)
tree8a228d4c6a1469b36412ca151a798ca66860cb5b
parent51dee5ef43bc84f1d45657c293a2ccb7ae7e1b0a (diff)
downloademacs-c4d82de839ead8d8b534ad11d14edc11d1ddbdb4.tar.gz
emacs-c4d82de839ead8d8b534ad11d14edc11d1ddbdb4.zip
Remove nnultimate.el and related code; Remove nnsoup.el, gnus-soup.el and related code; by Lars Magne Ingebrigtsen <larsi@gnus.org>.
-rw-r--r--doc/misc/gnus.texi336
-rw-r--r--lisp/gnus/ChangeLog6
-rw-r--r--lisp/gnus/gnus-group.el14
-rw-r--r--lisp/gnus/gnus-soup.el611
-rw-r--r--lisp/gnus/gnus-sum.el15
-rw-r--r--lisp/gnus/gnus.el6
-rw-r--r--lisp/gnus/nnsoup.el812
-rw-r--r--lisp/gnus/nnultimate.el480
8 files changed, 15 insertions, 2265 deletions
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8e2caf5a145..c931a6735aa 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -632,7 +632,7 @@ Select Methods
632* Getting Mail:: Reading your personal mail with Gnus. 632* Getting Mail:: Reading your personal mail with Gnus.
633* Browsing the Web:: Getting messages from a plethora of Web sources. 633* Browsing the Web:: Getting messages from a plethora of Web sources.
634* IMAP:: Using Gnus as a @acronym{IMAP} client. 634* IMAP:: Using Gnus as a @acronym{IMAP} client.
635* Other Sources:: Reading directories, files, SOUP packets. 635* Other Sources:: Reading directories, files.
636* Combined Groups:: Combining groups into one group. 636* Combined Groups:: Combining groups into one group.
637* Email Based Diary:: Using mails to manage diary events in Gnus. 637* Email Based Diary:: Using mails to manage diary events in Gnus.
638* Gnus Unplugged:: Reading news and mail offline. 638* Gnus Unplugged:: Reading news and mail offline.
@@ -695,7 +695,6 @@ Browsing the Web
695 695
696* Archiving Mail:: 696* Archiving Mail::
697* Web Searches:: Creating groups from articles that match a string. 697* Web Searches:: Creating groups from articles that match a string.
698* Ultimate:: The Ultimate Bulletin Board systems.
699* Web Archive:: Reading mailing list archived on web. 698* Web Archive:: Reading mailing list archived on web.
700* RSS:: Reading RDF site summary. 699* RSS:: Reading RDF site summary.
701* Customizing W3:: Doing stuff to Emacs/W3 from Gnus. 700* Customizing W3:: Doing stuff to Emacs/W3 from Gnus.
@@ -714,19 +713,12 @@ Other Sources
714* Directory Groups:: You can read a directory as if it was a newsgroup. 713* Directory Groups:: You can read a directory as if it was a newsgroup.
715* Anything Groups:: Dired? Who needs dired? 714* Anything Groups:: Dired? Who needs dired?
716* Document Groups:: Single files can be the basis of a group. 715* Document Groups:: Single files can be the basis of a group.
717* SOUP:: Reading @sc{soup} packets ``offline''.
718* Mail-To-News Gateways:: Posting articles via mail-to-news gateways. 716* Mail-To-News Gateways:: Posting articles via mail-to-news gateways.
719 717
720Document Groups 718Document Groups
721 719
722* Document Server Internals:: How to add your own document types. 720* Document Server Internals:: How to add your own document types.
723 721
724SOUP
725
726* SOUP Commands:: Commands for creating and sending @sc{soup} packets
727* SOUP Groups:: A back end for reading @sc{soup} packets.
728* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news.
729
730Combined Groups 722Combined Groups
731 723
732* Virtual Groups:: Combining articles from many groups. 724* Virtual Groups:: Combining articles from many groups.
@@ -6850,10 +6842,6 @@ Marked as read by a catchup (@code{gnus-catchup-mark}).
6850@vindex gnus-canceled-mark 6842@vindex gnus-canceled-mark
6851Canceled article (@code{gnus-canceled-mark}) 6843Canceled article (@code{gnus-canceled-mark})
6852 6844
6853@item F
6854@vindex gnus-souped-mark
6855@sc{soup}ed article (@code{gnus-souped-mark}). @xref{SOUP}.
6856
6857@item Q 6845@item Q
6858@vindex gnus-sparse-mark 6846@vindex gnus-sparse-mark
6859Sparsely reffed article (@code{gnus-sparse-mark}). @xref{Customizing 6847Sparsely reffed article (@code{gnus-sparse-mark}). @xref{Customizing
@@ -7824,7 +7812,7 @@ This is a rather obscure variable that few will find useful. It's
7824intended for those non-news newsgroups where the back end has to fetch 7812intended for those non-news newsgroups where the back end has to fetch
7825quite a lot to present the summary buffer, and where it's impossible to 7813quite a lot to present the summary buffer, and where it's impossible to
7826go back to parents of articles. This is mostly the case in the 7814go back to parents of articles. This is mostly the case in the
7827web-based groups, like the @code{nnultimate} groups. 7815web-based groups.
7828 7816
7829If you don't use those, then it's safe to leave this as the default 7817If you don't use those, then it's safe to leave this as the default
7830@code{nil}. If you want to use this variable, it should be a regexp 7818@code{nil}. If you want to use this variable, it should be a regexp
@@ -13746,7 +13734,7 @@ The different methods all have their peculiarities, of course.
13746* Getting Mail:: Reading your personal mail with Gnus. 13734* Getting Mail:: Reading your personal mail with Gnus.
13747* Browsing the Web:: Getting messages from a plethora of Web sources. 13735* Browsing the Web:: Getting messages from a plethora of Web sources.
13748* IMAP:: Using Gnus as a @acronym{IMAP} client. 13736* IMAP:: Using Gnus as a @acronym{IMAP} client.
13749* Other Sources:: Reading directories, files, SOUP packets. 13737* Other Sources:: Reading directories, files.
13750* Combined Groups:: Combining groups into one group. 13738* Combined Groups:: Combining groups into one group.
13751* Email Based Diary:: Using mails to manage diary events in Gnus. 13739* Email Based Diary:: Using mails to manage diary events in Gnus.
13752* Gnus Unplugged:: Reading news and mail offline. 13740* Gnus Unplugged:: Reading news and mail offline.
@@ -17407,7 +17395,6 @@ interfaces to these sources.
17407@menu 17395@menu
17408* Archiving Mail:: 17396* Archiving Mail::
17409* Web Searches:: Creating groups from articles that match a string. 17397* Web Searches:: Creating groups from articles that match a string.
17410* Ultimate:: The Ultimate Bulletin Board systems.
17411* Web Archive:: Reading mailing list archived on web. 17398* Web Archive:: Reading mailing list archived on web.
17412* RSS:: Reading RDF site summary. 17399* RSS:: Reading RDF site summary.
17413* Customizing W3:: Doing stuff to Emacs/W3 from Gnus. 17400* Customizing W3:: Doing stuff to Emacs/W3 from Gnus.
@@ -17551,34 +17538,6 @@ Format string URL to fetch an article by @code{Message-ID}.
17551@end table 17538@end table
17552 17539
17553 17540
17554@node Ultimate
17555@subsection Ultimate
17556@cindex nnultimate
17557@cindex Ultimate Bulletin Board
17558
17559@uref{http://www.ultimatebb.com/, The Ultimate Bulletin Board} is
17560probably the most popular Web bulletin board system used. It has a
17561quite regular and nice interface, and it's possible to get the
17562information Gnus needs to keep groups updated.
17563
17564The easiest way to get started with @code{nnultimate} is to say
17565something like the following in the group buffer: @kbd{B nnultimate RET
17566http://www.tcj.com/messboard/ubbcgi/ RET}. (Substitute the @acronym{URL}
17567(not including @samp{Ultimate.cgi} or the like at the end) for a forum
17568you're interested in; there's quite a list of them on the Ultimate web
17569site.) Then subscribe to the groups you're interested in from the
17570server buffer, and read them from the group buffer.
17571
17572The following @code{nnultimate} variables can be altered:
17573
17574@table @code
17575@item nnultimate-directory
17576@vindex nnultimate-directory
17577The directory where @code{nnultimate} stores its files. The default is@*
17578@file{~/News/ultimate/}.
17579@end table
17580
17581
17582@node Web Archive 17541@node Web Archive
17583@subsection Web Archive 17542@subsection Web Archive
17584@cindex nnwarchive 17543@cindex nnwarchive
@@ -18552,7 +18511,6 @@ newsgroups.
18552* Directory Groups:: You can read a directory as if it was a newsgroup. 18511* Directory Groups:: You can read a directory as if it was a newsgroup.
18553* Anything Groups:: Dired? Who needs dired? 18512* Anything Groups:: Dired? Who needs dired?
18554* Document Groups:: Single files can be the basis of a group. 18513* Document Groups:: Single files can be the basis of a group.
18555* SOUP:: Reading @sc{soup} packets ``offline''.
18556* Mail-To-News Gateways:: Posting articles via mail-to-news gateways. 18514* Mail-To-News Gateways:: Posting articles via mail-to-news gateways.
18557@end menu 18515@end menu
18558 18516
@@ -18920,289 +18878,6 @@ correct type. A high number means high probability; a low number
18920means low probability with @samp{0} being the lowest valid number. 18878means low probability with @samp{0} being the lowest valid number.
18921 18879
18922 18880
18923@node SOUP
18924@subsection SOUP
18925@cindex SOUP
18926@cindex offline
18927
18928In the PC world people often talk about ``offline'' newsreaders. These
18929are thingies that are combined reader/news transport monstrosities.
18930With built-in modem programs. Yecchh!
18931
18932Of course, us Unix Weenie types of human beans use things like
18933@code{uucp} and, like, @code{nntpd} and set up proper news and mail
18934transport things like Ghod intended. And then we just use normal
18935newsreaders.
18936
18937However, it can sometimes be convenient to do something that's a bit
18938easier on the brain if you have a very slow modem, and you're not really
18939that interested in doing things properly.
18940
18941A file format called @sc{soup} has been developed for transporting news
18942and mail from servers to home machines and back again. It can be a bit
18943fiddly.
18944
18945First some terminology:
18946
18947@table @dfn
18948
18949@item server
18950This is the machine that is connected to the outside world and where you
18951get news and/or mail from.
18952
18953@item home machine
18954This is the machine that you want to do the actual reading and responding
18955on. It is typically not connected to the rest of the world in any way.
18956
18957@item packet
18958Something that contains messages and/or commands. There are two kinds
18959of packets:
18960
18961@table @dfn
18962@item message packets
18963These are packets made at the server, and typically contain lots of
18964messages for you to read. These are called @file{SoupoutX.tgz} by
18965default, where @var{x} is a number.
18966
18967@item response packets
18968These are packets made at the home machine, and typically contains
18969replies that you've written. These are called @file{SoupinX.tgz} by
18970default, where @var{x} is a number.
18971
18972@end table
18973
18974@end table
18975
18976
18977@enumerate
18978
18979@item
18980You log in on the server and create a @sc{soup} packet. You can either
18981use a dedicated @sc{soup} thingie (like the @code{awk} program), or you
18982can use Gnus to create the packet with its @sc{soup} commands (@kbd{O
18983s} and/or @kbd{G s b}; and then @kbd{G s p}) (@pxref{SOUP Commands}).
18984
18985@item
18986You transfer the packet home. Rail, boat, car or modem will do fine.
18987
18988@item
18989You put the packet in your home directory.
18990
18991@item
18992You fire up Gnus on your home machine using the @code{nnsoup} back end as
18993the native or secondary server.
18994
18995@item
18996You read articles and mail and answer and followup to the things you
18997want (@pxref{SOUP Replies}).
18998
18999@item
19000You do the @kbd{G s r} command to pack these replies into a @sc{soup}
19001packet.
19002
19003@item
19004You transfer this packet to the server.
19005
19006@item
19007You use Gnus to mail this packet out with the @kbd{G s s} command.
19008
19009@item
19010You then repeat until you die.
19011
19012@end enumerate
19013
19014So you basically have a bipartite system---you use @code{nnsoup} for
19015reading and Gnus for packing/sending these @sc{soup} packets.
19016
19017@menu
19018* SOUP Commands:: Commands for creating and sending @sc{soup} packets
19019* SOUP Groups:: A back end for reading @sc{soup} packets.
19020* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news.
19021@end menu
19022
19023
19024@node SOUP Commands
19025@subsubsection SOUP Commands
19026
19027These are commands for creating and manipulating @sc{soup} packets.
19028
19029@table @kbd
19030@item G s b
19031@kindex G s b (Group)
19032@findex gnus-group-brew-soup
19033Pack all unread articles in the current group
19034(@code{gnus-group-brew-soup}). This command understands the
19035process/prefix convention.
19036
19037@item G s w
19038@kindex G s w (Group)
19039@findex gnus-soup-save-areas
19040Save all @sc{soup} data files (@code{gnus-soup-save-areas}).
19041
19042@item G s s
19043@kindex G s s (Group)
19044@findex gnus-soup-send-replies
19045Send all replies from the replies packet
19046(@code{gnus-soup-send-replies}).
19047
19048@item G s p
19049@kindex G s p (Group)
19050@findex gnus-soup-pack-packet
19051Pack all files into a @sc{soup} packet (@code{gnus-soup-pack-packet}).
19052
19053@item G s r
19054@kindex G s r (Group)
19055@findex nnsoup-pack-replies
19056Pack all replies into a replies packet (@code{nnsoup-pack-replies}).
19057
19058@item O s
19059@kindex O s (Summary)
19060@findex gnus-soup-add-article
19061This summary-mode command adds the current article to a @sc{soup} packet
19062(@code{gnus-soup-add-article}). It understands the process/prefix
19063convention (@pxref{Process/Prefix}).
19064
19065@end table
19066
19067
19068There are a few variables to customize where Gnus will put all these
19069thingies:
19070
19071@table @code
19072
19073@item gnus-soup-directory
19074@vindex gnus-soup-directory
19075Directory where Gnus will save intermediate files while composing
19076@sc{soup} packets. The default is @file{~/SoupBrew/}.
19077
19078@item gnus-soup-replies-directory
19079@vindex gnus-soup-replies-directory
19080This is what Gnus will use as a temporary directory while sending our
19081reply packets. @file{~/SoupBrew/SoupReplies/} is the default.
19082
19083@item gnus-soup-prefix-file
19084@vindex gnus-soup-prefix-file
19085Name of the file where Gnus stores the last used prefix. The default is
19086@samp{gnus-prefix}.
19087
19088@item gnus-soup-packer
19089@vindex gnus-soup-packer
19090A format string command for packing a @sc{soup} packet. The default is
19091@samp{tar cf - %s | gzip > $HOME/Soupout%d.tgz}.
19092
19093@item gnus-soup-unpacker
19094@vindex gnus-soup-unpacker
19095Format string command for unpacking a @sc{soup} packet. The default is
19096@samp{gunzip -c %s | tar xvf -}.
19097
19098@item gnus-soup-packet-directory
19099@vindex gnus-soup-packet-directory
19100Where Gnus will look for reply packets. The default is @file{~/}.
19101
19102@item gnus-soup-packet-regexp
19103@vindex gnus-soup-packet-regexp
19104Regular expression matching @sc{soup} reply packets in
19105@code{gnus-soup-packet-directory}.
19106
19107@end table
19108
19109
19110@node SOUP Groups
19111@subsubsection SOUP Groups
19112@cindex nnsoup
19113
19114@code{nnsoup} is the back end for reading @sc{soup} packets. It will
19115read incoming packets, unpack them, and put them in a directory where
19116you can read them at leisure.
19117
19118These are the variables you can use to customize its behavior:
19119
19120@table @code
19121
19122@item nnsoup-tmp-directory
19123@vindex nnsoup-tmp-directory
19124When @code{nnsoup} unpacks a @sc{soup} packet, it does it in this
19125directory. (@file{/tmp/} by default.)
19126
19127@item nnsoup-directory
19128@vindex nnsoup-directory
19129@code{nnsoup} then moves each message and index file to this directory.
19130The default is @file{~/SOUP/}.
19131
19132@item nnsoup-replies-directory
19133@vindex nnsoup-replies-directory
19134All replies will be stored in this directory before being packed into a
19135reply packet. The default is @file{~/SOUP/replies/}.
19136
19137@item nnsoup-replies-format-type
19138@vindex nnsoup-replies-format-type
19139The @sc{soup} format of the replies packets. The default is @samp{?n}
19140(rnews), and I don't think you should touch that variable. I probably
19141shouldn't even have documented it. Drats! Too late!
19142
19143@item nnsoup-replies-index-type
19144@vindex nnsoup-replies-index-type
19145The index type of the replies packet. The default is @samp{?n}, which
19146means ``none''. Don't fiddle with this one either!
19147
19148@item nnsoup-active-file
19149@vindex nnsoup-active-file
19150Where @code{nnsoup} stores lots of information. This is not an ``active
19151file'' in the @code{nntp} sense; it's an Emacs Lisp file. If you lose
19152this file or mess it up in any way, you're dead. The default is
19153@file{~/SOUP/active}.
19154
19155@item nnsoup-packer
19156@vindex nnsoup-packer
19157Format string command for packing a reply @sc{soup} packet. The default
19158is @samp{tar cf - %s | gzip > $HOME/Soupin%d.tgz}.
19159
19160@item nnsoup-unpacker
19161@vindex nnsoup-unpacker
19162Format string command for unpacking incoming @sc{soup} packets. The
19163default is @samp{gunzip -c %s | tar xvf -}.
19164
19165@item nnsoup-packet-directory
19166@vindex nnsoup-packet-directory
19167Where @code{nnsoup} will look for incoming packets. The default is
19168@file{~/}.
19169
19170@item nnsoup-packet-regexp
19171@vindex nnsoup-packet-regexp
19172Regular expression matching incoming @sc{soup} packets. The default is
19173@samp{Soupout}.
19174
19175@item nnsoup-always-save
19176@vindex nnsoup-always-save
19177If non-@code{nil}, save the replies buffer after each posted message.
19178
19179@end table
19180
19181
19182@node SOUP Replies
19183@subsubsection SOUP Replies
19184
19185Just using @code{nnsoup} won't mean that your postings and mailings end
19186up in @sc{soup} reply packets automagically. You have to work a bit
19187more for that to happen.
19188
19189@findex nnsoup-set-variables
19190The @code{nnsoup-set-variables} command will set the appropriate
19191variables to ensure that all your followups and replies end up in the
19192@sc{soup} system.
19193
19194In specific, this is what it does:
19195
19196@lisp
19197(setq message-send-news-function 'nnsoup-request-post)
19198(setq message-send-mail-function 'nnsoup-request-mail)
19199@end lisp
19200
19201And that's it, really. If you only want news to go into the @sc{soup}
19202system you just use the first line. If you only want mail to be
19203@sc{soup}ed you use the second.
19204
19205
19206@node Mail-To-News Gateways 18881@node Mail-To-News Gateways
19207@subsection Mail-To-News Gateways 18882@subsection Mail-To-News Gateways
19208@cindex mail-to-news gateways 18883@cindex mail-to-news gateways
@@ -27927,8 +27602,7 @@ news batches, ClariNet briefs collections, and just about everything
27927else (@pxref{Document Groups}). 27602else (@pxref{Document Groups}).
27928 27603
27929@item 27604@item
27930Gnus has a new back end (@code{nnsoup}) to create/read SOUP packets 27605Gnus has a new back end (@code{nnsoup}) to create/read SOUP packets.
27931(@pxref{SOUP}).
27932 27606
27933@item 27607@item
27934The Gnus cache is much faster. 27608The Gnus cache is much faster.
@@ -29492,7 +29166,7 @@ As the variables for the other back ends, there are
29492@code{nnml-nov-is-evil}, @code{nnspool-nov-is-evil}, and 29166@code{nnml-nov-is-evil}, @code{nnspool-nov-is-evil}, and
29493@code{nnwarchive-nov-is-evil}. Note that a non-@code{nil} value for 29167@code{nnwarchive-nov-is-evil}. Note that a non-@code{nil} value for
29494@code{gnus-nov-is-evil} overrides all those variables.@footnote{Although 29168@code{gnus-nov-is-evil} overrides all those variables.@footnote{Although
29495the back ends @code{nnkiboze}, @code{nnultimate}, and 29169+the back ends @code{nnkiboze}, and
29496@code{nnwfm} don't have their own nn*-nov-is-evil.} 29170@code{nnwfm} don't have their own nn*-nov-is-evil.}
29497@end table 29171@end table
29498 29172
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ecfdcc1ee4e..9eccb71c866 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,5 +1,11 @@
12010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> 12010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
2 2
3 * gnus-soup.el: Removed.
4
5 * nnsoup.el: Removed.
6
7 * nnultimate.el: Removed.
8
3 * gnus-html.el (gnus-blocked-images): New variable. 9 * gnus-html.el (gnus-blocked-images): New variable.
4 10
5 * message.el (message-prune-recipients): New function. 11 * message.el (message-prune-recipients): New function.
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index adab5650dc3..31f1718054c 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -680,13 +680,6 @@ simple manner.")
680 "\177" gnus-group-delete-group 680 "\177" gnus-group-delete-group
681 [delete] gnus-group-delete-group) 681 [delete] gnus-group-delete-group)
682 682
683(gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
684 "b" gnus-group-brew-soup
685 "w" gnus-soup-save-areas
686 "s" gnus-soup-send-replies
687 "p" gnus-soup-pack-packet
688 "r" nnsoup-pack-replies)
689
690(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) 683(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
691 "s" gnus-group-sort-groups 684 "s" gnus-group-sort-groups
692 "a" gnus-group-sort-groups-by-alphabet 685 "a" gnus-group-sort-groups-by-alphabet
@@ -972,13 +965,6 @@ simple manner.")
972 (easy-menu-define 965 (easy-menu-define
973 gnus-group-misc-menu gnus-group-mode-map "" 966 gnus-group-misc-menu gnus-group-mode-map ""
974 `("Gnus" 967 `("Gnus"
975 ("SOUP"
976 ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
977 ["Send replies" gnus-soup-send-replies
978 (fboundp 'gnus-soup-pack-packet)]
979 ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
980 ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
981 ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
982 ["Send a mail" gnus-group-mail t] 968 ["Send a mail" gnus-group-mail t]
983 ["Send a message (mail or news)" gnus-group-post-news t] 969 ["Send a message (mail or news)" gnus-group-post-news t]
984 ["Create a local message" gnus-group-news t] 970 ["Create a local message" gnus-group-news t]
diff --git a/lisp/gnus/gnus-soup.el b/lisp/gnus/gnus-soup.el
deleted file mode 100644
index 13271a9c15a..00000000000
--- a/lisp/gnus/gnus-soup.el
+++ /dev/null
@@ -1,611 +0,0 @@
1;;; gnus-soup.el --- SOUP packet writing support for Gnus
2
3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
7;; Lars Magne Ingebrigtsen <larsi@gnus.org>
8;; Keywords: news, mail
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;;; Code:
28
29(eval-when-compile (require 'cl))
30
31(require 'gnus)
32(require 'gnus-art)
33(require 'message)
34(require 'gnus-start)
35(require 'gnus-range)
36
37(defgroup gnus-soup nil
38 "SOUP packet writing support for Gnus."
39 :group 'gnus)
40
41;;; User Variables:
42
43(defcustom gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/")
44 "Directory containing an unpacked SOUP packet."
45 :version "22.1" ;; Gnus 5.10.9
46 :type 'directory
47 :group 'gnus-soup)
48
49(defcustom gnus-soup-replies-directory
50 (nnheader-concat gnus-soup-directory "SoupReplies/")
51 "Directory where Gnus will do processing of replies."
52 :version "22.1" ;; Gnus 5.10.9
53 :type 'directory
54 :group 'gnus-soup)
55
56(defcustom gnus-soup-prefix-file "gnus-prefix"
57 "Name of the file where Gnus stores the last used prefix."
58 :version "22.1" ;; Gnus 5.10.9
59 :type 'file
60 :group 'gnus-soup)
61
62(defcustom gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz"
63 "Format string command for packing a SOUP packet.
64The SOUP files will be inserted where the %s is in the string.
65This string MUST contain both %s and %d. The file number will be
66inserted where %d appears."
67 :version "22.1" ;; Gnus 5.10.9
68 :type 'string
69 :group 'gnus-soup)
70
71(defcustom gnus-soup-unpacker "gunzip -c %s | tar xvf -"
72 "Format string command for unpacking a SOUP packet.
73The SOUP packet file name will be inserted at the %s."
74 :version "22.1" ;; Gnus 5.10.9
75 :type 'string
76 :group 'gnus-soup)
77
78(defcustom gnus-soup-packet-directory gnus-home-directory
79 "Where gnus-soup will look for REPLIES packets."
80 :version "22.1" ;; Gnus 5.10.9
81 :type 'directory
82 :group 'gnus-soup)
83
84(defcustom gnus-soup-packet-regexp "Soupin"
85 "Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'."
86 :version "22.1" ;; Gnus 5.10.9
87 :type 'regexp
88 :group 'gnus-soup)
89
90(defcustom gnus-soup-ignored-headers "^Xref:"
91 "Regexp to match headers to be removed when brewing SOUP packets."
92 :version "22.1" ;; Gnus 5.10.9
93 :type 'regexp
94 :group 'gnus-soup)
95
96;;; Internal Variables:
97
98(defvar gnus-soup-encoding-type ?u
99 "*Soup encoding type.
100`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox
101format.")
102
103(defvar gnus-soup-index-type ?c
104 "*Soup index type.
105`n' means no index file and `c' means standard Cnews overview
106format.")
107
108(defvar gnus-soup-areas nil)
109(defvar gnus-soup-last-prefix nil)
110(defvar gnus-soup-prev-prefix nil)
111(defvar gnus-soup-buffers nil)
112
113;;; Access macros:
114
115(defmacro gnus-soup-area-prefix (area)
116 `(aref ,area 0))
117(defmacro gnus-soup-set-area-prefix (area prefix)
118 `(aset ,area 0 ,prefix))
119(defmacro gnus-soup-area-name (area)
120 `(aref ,area 1))
121(defmacro gnus-soup-area-encoding (area)
122 `(aref ,area 2))
123(defmacro gnus-soup-area-description (area)
124 `(aref ,area 3))
125(defmacro gnus-soup-area-number (area)
126 `(aref ,area 4))
127(defmacro gnus-soup-area-set-number (area value)
128 `(aset ,area 4 ,value))
129
130(defmacro gnus-soup-encoding-format (encoding)
131 `(aref ,encoding 0))
132(defmacro gnus-soup-encoding-index (encoding)
133 `(aref ,encoding 1))
134(defmacro gnus-soup-encoding-kind (encoding)
135 `(aref ,encoding 2))
136
137(defmacro gnus-soup-reply-prefix (reply)
138 `(aref ,reply 0))
139(defmacro gnus-soup-reply-kind (reply)
140 `(aref ,reply 1))
141(defmacro gnus-soup-reply-encoding (reply)
142 `(aref ,reply 2))
143
144;;; Commands:
145
146(defun gnus-soup-send-replies ()
147 "Unpack and send all replies in the reply packet."
148 (interactive)
149 (let ((packets (directory-files
150 gnus-soup-packet-directory t gnus-soup-packet-regexp)))
151 (while packets
152 (when (gnus-soup-send-packet (car packets))
153 (delete-file (car packets)))
154 (setq packets (cdr packets)))))
155
156(defun gnus-soup-add-article (n)
157 "Add the current article to SOUP packet.
158If N is a positive number, add the N next articles.
159If N is a negative number, add the N previous articles.
160If N is nil and any articles have been marked with the process mark,
161move those articles instead."
162 (interactive "P")
163 (let* ((articles (gnus-summary-work-articles n))
164 (tmp-buf (gnus-get-buffer-create "*soup work*"))
165 (area (gnus-soup-area gnus-newsgroup-name))
166 (prefix (gnus-soup-area-prefix area))
167 headers)
168 (buffer-disable-undo tmp-buf)
169 (save-excursion
170 (while articles
171 ;; Put the article in a buffer.
172 (set-buffer tmp-buf)
173 (when (gnus-request-article-this-buffer
174 (car articles) gnus-newsgroup-name)
175 (setq headers (nnheader-parse-head t))
176 (save-restriction
177 (message-narrow-to-head)
178 (message-remove-header gnus-soup-ignored-headers t))
179 (gnus-soup-store gnus-soup-directory prefix headers
180 gnus-soup-encoding-type
181 gnus-soup-index-type)
182 (gnus-soup-area-set-number
183 area (1+ (or (gnus-soup-area-number area) 0)))
184 ;; Mark article as read.
185 (set-buffer gnus-summary-buffer)
186 (gnus-summary-mark-as-read (car articles) gnus-souped-mark))
187 (gnus-summary-remove-process-mark (car articles))
188 (setq articles (cdr articles)))
189 (kill-buffer tmp-buf))
190 (gnus-soup-save-areas)
191 (gnus-set-mode-line 'summary)))
192
193(defun gnus-soup-pack-packet ()
194 "Make a SOUP packet from the SOUP areas."
195 (interactive)
196 (gnus-soup-read-areas)
197 (if (file-exists-p gnus-soup-directory)
198 (if (directory-files gnus-soup-directory nil "\\.MSG$")
199 (gnus-soup-pack gnus-soup-directory gnus-soup-packer)
200 (message "No files to pack."))
201 (message "No such directory: %s" gnus-soup-directory)))
202
203(defun gnus-group-brew-soup (n)
204 "Make a soup packet from the current group.
205Uses the process/prefix convention."
206 (interactive "P")
207 (let ((groups (gnus-group-process-prefix n)))
208 (while groups
209 (gnus-group-remove-mark (car groups))
210 (gnus-soup-group-brew (car groups) t)
211 (setq groups (cdr groups)))
212 (gnus-soup-save-areas)))
213
214(defun gnus-brew-soup (&optional level)
215 "Go through all groups on LEVEL or less and make a soup packet."
216 (interactive "P")
217 (let ((level (or level gnus-level-subscribed))
218 (newsrc (cdr gnus-newsrc-alist)))
219 (while newsrc
220 (when (<= (nth 1 (car newsrc)) level)
221 (gnus-soup-group-brew (caar newsrc) t))
222 (setq newsrc (cdr newsrc)))
223 (gnus-soup-save-areas)))
224
225;;;###autoload
226(defun gnus-batch-brew-soup ()
227 "Brew a SOUP packet from groups mention on the command line.
228Will use the remaining command line arguments as regular expressions
229for matching on group names.
230
231For instance, if you want to brew on all the nnml groups, as well as
232groups with \"emacs\" in the name, you could say something like:
233
234$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"
235
236Note -- this function hasn't been implemented yet."
237 (interactive)
238 nil)
239
240;;; Internal Functions:
241
242;; Store the current buffer.
243(defun gnus-soup-store (directory prefix headers format index)
244 ;; Create the directory, if needed.
245 (gnus-make-directory directory)
246 (let* ((msg-buf (nnheader-find-file-noselect
247 (concat directory prefix ".MSG")))
248 (idx-buf (if (= index ?n)
249 nil
250 (nnheader-find-file-noselect
251 (concat directory prefix ".IDX"))))
252 (article-buf (current-buffer))
253 from head-line beg type)
254 (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
255 (buffer-disable-undo msg-buf)
256 (when idx-buf
257 (push idx-buf gnus-soup-buffers)
258 (buffer-disable-undo idx-buf))
259 (save-excursion
260 ;; Make sure the last char in the buffer is a newline.
261 (goto-char (point-max))
262 (unless (= (current-column) 0)
263 (insert "\n"))
264 ;; Find the "from".
265 (goto-char (point-min))
266 (setq from
267 (gnus-mail-strip-quoted-names
268 (or (mail-fetch-field "from")
269 (mail-fetch-field "really-from")
270 (mail-fetch-field "sender"))))
271 (goto-char (point-min))
272 ;; Depending on what encoding is supposed to be used, we make
273 ;; a soup header.
274 (setq head-line
275 (cond
276 ((or (= gnus-soup-encoding-type ?u)
277 (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility.
278 (format "#! rnews %d\n" (buffer-size)))
279 ((= gnus-soup-encoding-type ?m)
280 (while (search-forward "\nFrom " nil t)
281 (replace-match "\n>From " t t))
282 (concat "From " (or from "unknown")
283 " " (current-time-string) "\n"))
284 ((= gnus-soup-encoding-type ?M)
285 "\^a\^a\^a\^a\n")
286 (t (error "Unsupported type: %c" gnus-soup-encoding-type))))
287 ;; Insert the soup header and the article in the MSG buf.
288 (set-buffer msg-buf)
289 (goto-char (point-max))
290 (insert head-line)
291 (setq beg (point))
292 (insert-buffer-substring article-buf)
293 ;; Insert the index in the IDX buf.
294 (cond ((= index ?c)
295 (set-buffer idx-buf)
296 (gnus-soup-insert-idx beg headers))
297 ((/= index ?n)
298 (error "Unknown index type: %c" type)))
299 ;; Return the MSG buf.
300 msg-buf)))
301
302(defun gnus-soup-group-brew (group &optional not-all)
303 "Enter GROUP and add all articles to a SOUP package.
304If NOT-ALL, don't pack ticked articles."
305 (let ((gnus-expert-user t)
306 (gnus-large-newsgroup nil)
307 (entry (gnus-group-entry group)))
308 (when (or (null entry)
309 (eq (car entry) t)
310 (and (car entry)
311 (> (car entry) 0))
312 (and (not not-all)
313 (gnus-range-length (cdr (assq 'tick (gnus-info-marks
314 (nth 2 entry)))))))
315 (when (gnus-summary-read-group group nil t)
316 (setq gnus-newsgroup-processable
317 (reverse
318 (if (not not-all)
319 (append gnus-newsgroup-marked gnus-newsgroup-unreads)
320 gnus-newsgroup-unreads)))
321 (gnus-soup-add-article nil)
322 (gnus-summary-exit)))))
323
324(defun gnus-soup-insert-idx (offset header)
325 ;; [number subject from date id references chars lines xref]
326 (goto-char (point-max))
327 (insert
328 (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n"
329 offset
330 (or (mail-header-subject header) "(none)")
331 (or (mail-header-from header) "(nobody)")
332 (or (mail-header-date header) "")
333 (or (mail-header-id header)
334 (concat "soup-dummy-id-"
335 (mapconcat
336 (lambda (time) (int-to-string time))
337 (current-time) "-")))
338 (or (mail-header-references header) "")
339 (or (mail-header-chars header) 0)
340 (or (mail-header-lines header) "0"))))
341
342(defun gnus-soup-save-areas ()
343 "Write all SOUP buffers."
344 (interactive)
345 (gnus-soup-write-areas)
346 (save-excursion
347 (let (buf)
348 (while gnus-soup-buffers
349 (setq buf (car gnus-soup-buffers)
350 gnus-soup-buffers (cdr gnus-soup-buffers))
351 (if (not (buffer-name buf))
352 ()
353 (set-buffer buf)
354 (when (buffer-modified-p)
355 (save-buffer))
356 (kill-buffer (current-buffer)))))
357 (gnus-soup-write-prefixes)))
358
359(defun gnus-soup-write-prefixes ()
360 (let ((prefixes gnus-soup-last-prefix)
361 prefix)
362 (save-excursion
363 (gnus-set-work-buffer)
364 (while (setq prefix (pop prefixes))
365 (erase-buffer)
366 (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))
367 (let ((coding-system-for-write mm-text-coding-system))
368 (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))))
369
370(defun gnus-soup-pack (dir packer)
371 (let* ((files (mapconcat 'identity
372 '("AREAS" "*.MSG" "*.IDX" "INFO"
373 "LIST" "REPLIES" "COMMANDS" "ERRORS")
374 " "))
375 (packer (if (< (string-match "%s" packer)
376 (string-match "%d" packer))
377 (format packer files
378 (string-to-number (gnus-soup-unique-prefix dir)))
379 (format packer
380 (string-to-number (gnus-soup-unique-prefix dir))
381 files)))
382 (dir (expand-file-name dir)))
383 (gnus-make-directory dir)
384 (setq gnus-soup-areas nil)
385 (gnus-message 4 "Packing %s..." packer)
386 (if (eq 0 (call-process shell-file-name
387 nil nil nil shell-command-switch
388 (concat "cd " dir " ; " packer)))
389 (progn
390 (call-process shell-file-name nil nil nil shell-command-switch
391 (concat "cd " dir " ; rm " files))
392 (gnus-message 4 "Packing...done" packer))
393 (error "Couldn't pack packet"))))
394
395(defun gnus-soup-parse-areas (file)
396 "Parse soup area file FILE.
397The result is a of vectors, each containing one entry from the AREA file.
398The vector contain five strings,
399 [prefix name encoding description number]
400though the two last may be nil if they are missing."
401 (let (areas)
402 (when (file-exists-p file)
403 (save-excursion
404 (set-buffer (nnheader-find-file-noselect file 'force))
405 (buffer-disable-undo)
406 (goto-char (point-min))
407 (while (not (eobp))
408 (push (vector (gnus-soup-field)
409 (gnus-soup-field)
410 (gnus-soup-field)
411 (and (eq (preceding-char) ?\t)
412 (gnus-soup-field))
413 (and (eq (preceding-char) ?\t)
414 (string-to-number (gnus-soup-field))))
415 areas)
416 (when (eq (preceding-char) ?\t)
417 (beginning-of-line 2)))
418 (kill-buffer (current-buffer))))
419 areas))
420
421(defun gnus-soup-parse-replies (file)
422 "Parse soup REPLIES file FILE.
423The result is a of vectors, each containing one entry from the REPLIES
424file. The vector contain three strings, [prefix name encoding]."
425 (let (replies)
426 (save-excursion
427 (set-buffer (nnheader-find-file-noselect file))
428 (buffer-disable-undo)
429 (goto-char (point-min))
430 (while (not (eobp))
431 (push (vector (gnus-soup-field) (gnus-soup-field)
432 (gnus-soup-field))
433 replies)
434 (when (eq (preceding-char) ?\t)
435 (beginning-of-line 2)))
436 (kill-buffer (current-buffer)))
437 replies))
438
439(defun gnus-soup-field ()
440 (prog1
441 (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point)))
442 (forward-char 1)))
443
444(defun gnus-soup-read-areas ()
445 (or gnus-soup-areas
446 (setq gnus-soup-areas
447 (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS")))))
448
449(defun gnus-soup-write-areas ()
450 "Write the AREAS file."
451 (interactive)
452 (when gnus-soup-areas
453 (with-temp-file (concat gnus-soup-directory "AREAS")
454 (let ((areas gnus-soup-areas)
455 area)
456 (while (setq area (pop areas))
457 (insert
458 (format
459 "%s\t%s\t%s%s\n"
460 (gnus-soup-area-prefix area)
461 (gnus-soup-area-name area)
462 (gnus-soup-area-encoding area)
463 (if (or (gnus-soup-area-description area)
464 (gnus-soup-area-number area))
465 (concat "\t" (or (gnus-soup-area-description
466 area) "")
467 (if (gnus-soup-area-number area)
468 (concat "\t" (int-to-string
469 (gnus-soup-area-number area)))
470 "")) ""))))))))
471
472(defun gnus-soup-write-replies (dir areas)
473 "Write a REPLIES file in DIR containing AREAS."
474 (with-temp-file (concat dir "REPLIES")
475 (let (area)
476 (while (setq area (pop areas))
477 (insert (format "%s\t%s\t%s\n"
478 (gnus-soup-reply-prefix area)
479 (gnus-soup-reply-kind area)
480 (gnus-soup-reply-encoding area)))))))
481
482(defun gnus-soup-area (group)
483 (gnus-soup-read-areas)
484 (let ((areas gnus-soup-areas)
485 (real-group (gnus-group-real-name group))
486 area result)
487 (while areas
488 (setq area (car areas)
489 areas (cdr areas))
490 (when (equal (gnus-soup-area-name area) real-group)
491 (setq result area)))
492 (unless result
493 (setq result
494 (vector (gnus-soup-unique-prefix)
495 real-group
496 (format "%c%c%c"
497 gnus-soup-encoding-type
498 gnus-soup-index-type
499 (if (gnus-member-of-valid 'mail group) ?m ?n))
500 nil nil)
501 gnus-soup-areas (cons result gnus-soup-areas)))
502 result))
503
504(defun gnus-soup-unique-prefix (&optional dir)
505 (let* ((dir (file-name-as-directory (or dir gnus-soup-directory)))
506 (entry (assoc dir gnus-soup-last-prefix))
507 gnus-soup-prev-prefix)
508 (if entry
509 ()
510 (when (file-exists-p (concat dir gnus-soup-prefix-file))
511 (ignore-errors
512 (load (concat dir gnus-soup-prefix-file) nil t t)))
513 (push (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
514 gnus-soup-last-prefix))
515 (setcdr entry (1+ (cdr entry)))
516 (gnus-soup-write-prefixes)
517 (int-to-string (cdr entry))))
518
519(defun gnus-soup-unpack-packet (dir unpacker packet)
520 "Unpack PACKET into DIR using UNPACKER.
521Return whether the unpacking was successful."
522 (gnus-make-directory dir)
523 (gnus-message 4 "Unpacking: %s" (format unpacker packet))
524 (prog1
525 (eq 0 (call-process
526 shell-file-name nil nil nil shell-command-switch
527 (format "cd %s ; %s" (expand-file-name dir)
528 (format unpacker packet))))
529 (gnus-message 4 "Unpacking...done")))
530
531(defun gnus-soup-send-packet (packet)
532 (gnus-soup-unpack-packet
533 gnus-soup-replies-directory gnus-soup-unpacker packet)
534 (let ((replies (gnus-soup-parse-replies
535 (concat gnus-soup-replies-directory "REPLIES"))))
536 (save-excursion
537 (while replies
538 (let* ((msg-file (concat gnus-soup-replies-directory
539 (gnus-soup-reply-prefix (car replies))
540 ".MSG"))
541 (msg-buf (and (file-exists-p msg-file)
542 (nnheader-find-file-noselect msg-file)))
543 (tmp-buf (gnus-get-buffer-create " *soup send*"))
544 beg end)
545 (cond
546 ((and (/= (gnus-soup-encoding-format
547 (gnus-soup-reply-encoding (car replies)))
548 ?u)
549 (/= (gnus-soup-encoding-format
550 (gnus-soup-reply-encoding (car replies)))
551 ?n)) ;; Gnus back compatibility.
552 (error "Unsupported encoding"))
553 ((null msg-buf)
554 t)
555 (t
556 (buffer-disable-undo msg-buf)
557 (set-buffer msg-buf)
558 (goto-char (point-min))
559 (while (not (eobp))
560 (unless (looking-at "#! *rnews +\\([0-9]+\\)")
561 (error "Bad header"))
562 (forward-line 1)
563 (setq beg (point)
564 end (+ (point) (string-to-number
565 (buffer-substring
566 (match-beginning 1) (match-end 1)))))
567 (switch-to-buffer tmp-buf)
568 (erase-buffer)
569 (mm-disable-multibyte)
570 (insert-buffer-substring msg-buf beg end)
571 (cond
572 ((string= (gnus-soup-reply-kind (car replies)) "news")
573 (gnus-message 5 "Sending news message to %s..."
574 (mail-fetch-field "newsgroups"))
575 (sit-for 1)
576 (let ((message-syntax-checks
577 'dont-check-for-anything-just-trust-me)
578 (method (if (functionp message-post-method)
579 (funcall message-post-method)
580 message-post-method))
581 result)
582 (run-hooks 'message-send-news-hook)
583 (gnus-open-server method)
584 (message "Sending news via %s..."
585 (gnus-server-string method))
586 (unless (let ((mail-header-separator ""))
587 (gnus-request-post method))
588 (message "Couldn't send message via news: %s"
589 (nnheader-get-report (car method))))))
590 ((string= (gnus-soup-reply-kind (car replies)) "mail")
591 (gnus-message 5 "Sending mail to %s..."
592 (mail-fetch-field "to"))
593 (sit-for 1)
594 (let ((mail-header-separator ""))
595 (funcall (or message-send-mail-real-function
596 message-send-mail-function))))
597 (t
598 (error "Unknown reply kind")))
599 (set-buffer msg-buf)
600 (goto-char end))
601 (delete-file (buffer-file-name))
602 (kill-buffer msg-buf)
603 (kill-buffer tmp-buf)
604 (gnus-message 4 "Sent packet"))))
605 (setq replies (cdr replies)))
606 t)))
607
608(provide 'gnus-soup)
609
610;; arch-tag: eddfa69d-13e8-4aea-84ef-62a526ef185c
611;;; gnus-soup.el ends here
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index f166aeff1e5..cd0824f9891 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -538,11 +538,6 @@ string with the suggested prefix."
538 :group 'gnus-summary-marks 538 :group 'gnus-summary-marks
539 :type 'character) 539 :type 'character)
540 540
541(defcustom gnus-souped-mark ?F
542 "*Mark used for souped articles."
543 :group 'gnus-summary-marks
544 :type 'character)
545
546(defcustom gnus-kill-file-mark ?X 541(defcustom gnus-kill-file-mark ?X
547 "*Mark used for articles killed by kill files." 542 "*Mark used for articles killed by kill files."
548 :group 'gnus-summary-marks 543 :group 'gnus-summary-marks
@@ -666,7 +661,7 @@ string with the suggested prefix."
666(defcustom gnus-auto-expirable-marks 661(defcustom gnus-auto-expirable-marks
667 (list gnus-killed-mark gnus-del-mark gnus-catchup-mark 662 (list gnus-killed-mark gnus-del-mark gnus-catchup-mark
668 gnus-low-score-mark gnus-ancient-mark gnus-read-mark 663 gnus-low-score-mark gnus-ancient-mark gnus-read-mark
669 gnus-souped-mark gnus-duplicate-mark) 664 gnus-duplicate-mark)
670 "*The list of marks converted into expiration if a group is auto-expirable." 665 "*The list of marks converted into expiration if a group is auto-expirable."
671 :version "21.1" 666 :version "21.1"
672 :group 'gnus-summary 667 :group 'gnus-summary
@@ -1258,7 +1253,7 @@ type of files to save."
1258 "Whether Gnus should parse all headers made available to it. 1253 "Whether Gnus should parse all headers made available to it.
1259This is mostly relevant for slow back ends where the user may 1254This is mostly relevant for slow back ends where the user may
1260wish to widen the summary buffer to include all headers 1255wish to widen the summary buffer to include all headers
1261that were fetched. Say, for nnultimate groups." 1256that were fetched."
1262 :version "22.1" 1257 :version "22.1"
1263 :group 'gnus-summary 1258 :group 'gnus-summary
1264 :type '(choice boolean regexp)) 1259 :type '(choice boolean regexp))
@@ -2180,8 +2175,7 @@ increase the score of each group you read."
2180 "h" gnus-summary-save-article-folder 2175 "h" gnus-summary-save-article-folder
2181 "v" gnus-summary-save-article-vm 2176 "v" gnus-summary-save-article-vm
2182 "p" gnus-summary-pipe-output 2177 "p" gnus-summary-pipe-output
2183 "P" gnus-summary-muttprint 2178 "P" gnus-summary-muttprint)
2184 "s" gnus-soup-add-article)
2185 2179
2186(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) 2180(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
2187 "b" gnus-summary-display-buttonized 2181 "b" gnus-summary-display-buttonized
@@ -2445,7 +2439,6 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2445 ["Save in RMAIL mbox..." gnus-summary-save-article-rmail t] 2439 ["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
2446 ["Save body in file..." gnus-summary-save-article-body-file t] 2440 ["Save body in file..." gnus-summary-save-article-body-file t]
2447 ["Pipe through a filter..." gnus-summary-pipe-output t] 2441 ["Pipe through a filter..." gnus-summary-pipe-output t]
2448 ["Add to SOUP packet" gnus-soup-add-article t]
2449 ["Print with Muttprint..." gnus-summary-muttprint t] 2442 ["Print with Muttprint..." gnus-summary-muttprint t]
2450 ["Print" gnus-summary-print-article 2443 ["Print" gnus-summary-print-article
2451 ,@(if (featurep 'xemacs) '(t) 2444 ,@(if (featurep 'xemacs) '(t)
@@ -8305,7 +8298,7 @@ If ALL is non-nil, limit strictly to unread articles."
8305 gnus-killed-mark gnus-spam-mark gnus-kill-file-mark 8298 gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
8306 gnus-low-score-mark gnus-expirable-mark 8299 gnus-low-score-mark gnus-expirable-mark
8307 gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark 8300 gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
8308 gnus-duplicate-mark gnus-souped-mark) 8301 gnus-duplicate-mark)
8309 'reverse))) 8302 'reverse)))
8310 8303
8311(defun gnus-summary-limit-to-headers (match &optional reverse) 8304(defun gnus-summary-limit-to-headers (match &optional reverse)
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 089bc68742c..d95ebd7acec 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1741,12 +1741,10 @@ slower."
1741 ("nndoc" none address prompt-address) 1741 ("nndoc" none address prompt-address)
1742 ("nnbabyl" mail address respool) 1742 ("nnbabyl" mail address respool)
1743 ("nnkiboze" post virtual) 1743 ("nnkiboze" post virtual)
1744 ("nnsoup" post-mail address)
1745 ("nndraft" post-mail) 1744 ("nndraft" post-mail)
1746 ("nnfolder" mail respool address) 1745 ("nnfolder" mail respool address)
1747 ("nngateway" post-mail address prompt-address physical-address) 1746 ("nngateway" post-mail address prompt-address physical-address)
1748 ("nnweb" none) 1747 ("nnweb" none)
1749 ("nnultimate" none)
1750 ("nnrss" none) 1748 ("nnrss" none)
1751 ("nnwfm" none) 1749 ("nnwfm" none)
1752 ("nnwarchive" none) 1750 ("nnwarchive" none)
@@ -2892,10 +2890,6 @@ gnus-registry.el will populate this if it's loaded.")
2892 ("rmailsum" rmail-update-summary) 2890 ("rmailsum" rmail-update-summary)
2893 ("gnus-audio" :interactive t gnus-audio-play) 2891 ("gnus-audio" :interactive t gnus-audio-play)
2894 ("gnus-xmas" gnus-xmas-splash) 2892 ("gnus-xmas" gnus-xmas-splash)
2895 ("gnus-soup" :interactive t
2896 gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
2897 gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
2898 ("nnsoup" nnsoup-pack-replies)
2899 ("score-mode" :interactive t gnus-score-mode) 2893 ("score-mode" :interactive t gnus-score-mode)
2900 ("gnus-mh" gnus-summary-save-article-folder 2894 ("gnus-mh" gnus-summary-save-article-folder
2901 gnus-Folder-save-name gnus-folder-save-name) 2895 gnus-Folder-save-name gnus-folder-save-name)
diff --git a/lisp/gnus/nnsoup.el b/lisp/gnus/nnsoup.el
deleted file mode 100644
index 3cb453818bc..00000000000
--- a/lisp/gnus/nnsoup.el
+++ /dev/null
@@ -1,812 +0,0 @@
1;;; nnsoup.el --- SOUP access for Gnus
2
3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
4;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
8;; Keywords: news, mail
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;;; Code:
28
29(require 'nnheader)
30(require 'nnmail)
31(require 'gnus-soup)
32(require 'gnus-msg)
33(require 'nnoo)
34(eval-when-compile (require 'cl))
35
36(nnoo-declare nnsoup)
37
38(defvoo nnsoup-directory (nnheader-concat gnus-home-directory "SOUP/")
39 "*SOUP packet directory.")
40
41(defvoo nnsoup-tmp-directory
42 (cond ((fboundp 'temp-directory) (temp-directory))
43 ((boundp 'temporary-file-directory) temporary-file-directory)
44 ("/tmp/"))
45 "*Where nnsoup will store temporary files.")
46
47(defvoo nnsoup-replies-directory (expand-file-name "replies/" nnsoup-directory)
48 "*Directory where outgoing packets will be composed.")
49
50(defvoo nnsoup-replies-format-type ?u ;; u is USENET news format.
51 "*Format of the replies packages.")
52
53(defvoo nnsoup-replies-index-type ?n
54 "*Index type of the replies packages.")
55
56(defvoo nnsoup-active-file (expand-file-name "active" nnsoup-directory)
57 "Active file.")
58
59(defvoo nnsoup-packer (concat "tar cf - %s | gzip > "
60 (expand-file-name gnus-home-directory)
61 "Soupin%d.tgz")
62 "Format string command for packing a SOUP packet.
63The SOUP files will be inserted where the %s is in the string.
64This string MUST contain both %s and %d. The file number will be
65inserted where %d appears.")
66
67(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -"
68 "*Format string command for unpacking a SOUP packet.
69The SOUP packet file name will be inserted at the %s.")
70
71(defvoo nnsoup-packet-directory gnus-home-directory
72 "*Where nnsoup will look for incoming packets.")
73
74(defvoo nnsoup-packet-regexp "Soupout"
75 "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
76
77(defvoo nnsoup-always-save t
78 "If non-nil commit the reply buffer on each message send.
79This is necessary if using message mode outside Gnus with nnsoup as a
80backend for the messages.")
81
82
83
84(defconst nnsoup-version "nnsoup 0.0"
85 "nnsoup version.")
86
87(defvoo nnsoup-status-string "")
88(defvoo nnsoup-group-alist nil)
89(defvoo nnsoup-current-prefix 0)
90(defvoo nnsoup-replies-list nil)
91(defvoo nnsoup-buffers nil)
92(defvoo nnsoup-current-group nil)
93(defvoo nnsoup-group-alist-touched nil)
94(defvoo nnsoup-article-alist nil)
95
96
97;;; Interface functions.
98
99(nnoo-define-basics nnsoup)
100
101(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old)
102 (nnsoup-possibly-change-group group)
103 (save-excursion
104 (set-buffer nntp-server-buffer)
105 (erase-buffer)
106 (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist)))
107 (articles sequence)
108 (use-nov t)
109 useful-areas this-area-seq msg-buf)
110 (if (stringp (car sequence))
111 ;; We don't support fetching by Message-ID.
112 'headers
113 ;; We go through all the areas and find which files the
114 ;; articles in SEQUENCE come from.
115 (while (and areas sequence)
116 ;; Peel off areas that are below sequence.
117 (while (and areas (< (cdar (car areas)) (car sequence)))
118 (setq areas (cdr areas)))
119 (when areas
120 ;; This is a useful area.
121 (push (car areas) useful-areas)
122 (setq this-area-seq nil)
123 ;; We take note whether this MSG has a corresponding IDX
124 ;; for later use.
125 (when (or (= (gnus-soup-encoding-index
126 (gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
127 (not (file-exists-p
128 (nnsoup-file
129 (gnus-soup-area-prefix (nth 1 (car areas)))))))
130 (setq use-nov nil))
131 ;; We assign the portion of `sequence' that is relevant to
132 ;; this MSG packet to this packet.
133 (while (and sequence (<= (car sequence) (cdar (car areas))))
134 (push (car sequence) this-area-seq)
135 (setq sequence (cdr sequence)))
136 (setcar useful-areas (cons (nreverse this-area-seq)
137 (car useful-areas)))))
138
139 ;; We now have a list of article numbers and corresponding
140 ;; areas.
141 (setq useful-areas (nreverse useful-areas))
142
143 ;; Two different approaches depending on whether all the MSG
144 ;; files have corresponding IDX files. If they all do, we
145 ;; simply return the relevant IDX files and let Gnus sort out
146 ;; what lines are relevant. If some of the IDX files are
147 ;; missing, we must return HEADs for all the articles.
148 (if use-nov
149 ;; We have IDX files for all areas.
150 (progn
151 (while useful-areas
152 (goto-char (point-max))
153 (let ((b (point))
154 (number (car (nth 1 (car useful-areas))))
155 (index-buffer (nnsoup-index-buffer
156 (gnus-soup-area-prefix
157 (nth 2 (car useful-areas))))))
158 (when index-buffer
159 (insert-buffer-substring index-buffer)
160 (goto-char b)
161 ;; We have to remove the index number entries and
162 ;; insert article numbers instead.
163 (while (looking-at "[0-9]+")
164 (replace-match (int-to-string number) t t)
165 (incf number)
166 (forward-line 1))))
167 (setq useful-areas (cdr useful-areas)))
168 'nov)
169 ;; We insert HEADs.
170 (while useful-areas
171 (setq articles (caar useful-areas)
172 useful-areas (cdr useful-areas))
173 (while articles
174 (when (setq msg-buf
175 (nnsoup-narrow-to-article
176 (car articles) (cdar useful-areas) 'head))
177 (goto-char (point-max))
178 (insert (format "221 %d Article retrieved.\n" (car articles)))
179 (insert-buffer-substring msg-buf)
180 (goto-char (point-max))
181 (insert ".\n"))
182 (setq articles (cdr articles))))
183
184 (nnheader-fold-continuation-lines)
185 'headers)))))
186
187(deffoo nnsoup-open-server (server &optional defs)
188 (nnoo-change-server 'nnsoup server defs)
189 (when (not (file-exists-p nnsoup-directory))
190 (condition-case ()
191 (make-directory nnsoup-directory t)
192 (error t)))
193 (cond
194 ((not (file-exists-p nnsoup-directory))
195 (nnsoup-close-server)
196 (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
197 ((not (file-directory-p (file-truename nnsoup-directory)))
198 (nnsoup-close-server)
199 (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory))
200 (t
201 (nnsoup-read-active-file)
202 (nnheader-report 'nnsoup "Opened server %s using directory %s"
203 server nnsoup-directory)
204 t)))
205
206(deffoo nnsoup-request-close ()
207 (nnsoup-write-active-file)
208 (nnsoup-write-replies)
209 (gnus-soup-save-areas)
210 ;; Kill all nnsoup buffers.
211 (let (buffer)
212 (while nnsoup-buffers
213 (setq buffer (cdr (pop nnsoup-buffers)))
214 (and buffer
215 (buffer-name buffer)
216 (kill-buffer buffer))))
217 (setq nnsoup-group-alist nil
218 nnsoup-group-alist-touched nil
219 nnsoup-current-group nil
220 nnsoup-replies-list nil)
221 (nnoo-close-server 'nnoo)
222 t)
223
224(deffoo nnsoup-request-article (id &optional newsgroup server buffer)
225 (nnsoup-possibly-change-group newsgroup)
226 (let (buf)
227 (save-excursion
228 (set-buffer (or buffer nntp-server-buffer))
229 (erase-buffer)
230 (when (and (not (stringp id))
231 (setq buf (nnsoup-narrow-to-article id)))
232 (insert-buffer-substring buf)
233 t))))
234
235(deffoo nnsoup-request-group (group &optional server dont-check)
236 (nnsoup-possibly-change-group group)
237 (if dont-check
238 t
239 (let ((active (cadr (assoc group nnsoup-group-alist))))
240 (if (not active)
241 (nnheader-report 'nnsoup "No such group: %s" group)
242 (nnheader-insert
243 "211 %d %d %d %s\n"
244 (max (1+ (- (cdr active) (car active))) 0)
245 (car active) (cdr active) group)))))
246
247(deffoo nnsoup-request-type (group &optional article)
248 (nnsoup-possibly-change-group group)
249 ;; Try to guess the type based on the first article in the group.
250 (when (not article)
251 (setq article
252 (cdar (car (cddr (assoc group nnsoup-group-alist))))))
253 (if (not article)
254 'unknown
255 (let ((kind (gnus-soup-encoding-kind
256 (gnus-soup-area-encoding
257 (nth 1 (nnsoup-article-to-area
258 article nnsoup-current-group))))))
259 (cond ((= kind ?m) 'mail)
260 ((= kind ?n) 'news)
261 (t 'unknown)))))
262
263(deffoo nnsoup-close-group (group &optional server)
264 ;; Kill all nnsoup buffers.
265 (let ((buffers nnsoup-buffers)
266 elem)
267 (while buffers
268 (when (equal (car (setq elem (pop buffers))) group)
269 (setq nnsoup-buffers (delq elem nnsoup-buffers))
270 (and (cdr elem) (buffer-name (cdr elem))
271 (kill-buffer (cdr elem))))))
272 t)
273
274(deffoo nnsoup-request-list (&optional server)
275 (save-excursion
276 (set-buffer nntp-server-buffer)
277 (erase-buffer)
278 (unless nnsoup-group-alist
279 (nnsoup-read-active-file))
280 (let ((alist nnsoup-group-alist)
281 (standard-output (current-buffer))
282 entry)
283 (while (setq entry (pop alist))
284 (insert (car entry) " ")
285 (princ (cdadr entry))
286 (insert " ")
287 (princ (caadr entry))
288 (insert " y\n"))
289 t)))
290
291(deffoo nnsoup-request-scan (group &optional server)
292 (nnsoup-unpack-packets))
293
294(deffoo nnsoup-request-newgroups (date &optional server)
295 (nnsoup-request-list))
296
297(deffoo nnsoup-request-list-newsgroups (&optional server)
298 nil)
299
300(deffoo nnsoup-request-post (&optional server)
301 (nnsoup-store-reply "news")
302 t)
303
304(deffoo nnsoup-request-mail (&optional server)
305 (nnsoup-store-reply "mail")
306 t)
307
308(deffoo nnsoup-request-expire-articles (articles group &optional server force)
309 (nnsoup-possibly-change-group group)
310 (let* ((total-infolist (assoc group nnsoup-group-alist))
311 (active (cadr total-infolist))
312 (infolist (cddr total-infolist))
313 info range-list mod-time prefix)
314 (while infolist
315 (setq info (pop infolist)
316 range-list (gnus-uncompress-range (car info))
317 prefix (gnus-soup-area-prefix (nth 1 info)))
318 (when;; All the articles in this file are marked for expiry.
319 (and (or (setq mod-time (nth 5 (file-attributes
320 (nnsoup-file prefix))))
321 (setq mod-time (nth 5 (file-attributes
322 (nnsoup-file prefix t)))))
323 (gnus-sublist-p articles range-list)
324 ;; This file is old enough.
325 (nnmail-expired-article-p group mod-time force))
326 ;; Ok, we delete this file.
327 (when (ignore-errors
328 (nnheader-message
329 5 "Deleting %s in group %s..." (nnsoup-file prefix)
330 group)
331 (when (file-exists-p (nnsoup-file prefix))
332 (delete-file (nnsoup-file prefix)))
333 (nnheader-message
334 5 "Deleting %s in group %s..." (nnsoup-file prefix t)
335 group)
336 (when (file-exists-p (nnsoup-file prefix t))
337 (delete-file (nnsoup-file prefix t)))
338 t)
339 (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
340 (setq articles (gnus-sorted-difference articles range-list))))
341 (when (not mod-time)
342 (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
343 (if (cddr total-infolist)
344 (setcar active (caaadr (cdr total-infolist)))
345 (setcar active (1+ (cdr active))))
346 (nnsoup-write-active-file t)
347 ;; Return the articles that weren't expired.
348 articles))
349
350
351;;; Internal functions
352
353(defun nnsoup-possibly-change-group (group &optional force)
354 (when (and group
355 (not (equal nnsoup-current-group group)))
356 (setq nnsoup-article-alist nil)
357 (setq nnsoup-current-group group))
358 t)
359
360(defun nnsoup-read-active-file ()
361 (setq nnsoup-group-alist nil)
362 (when (file-exists-p nnsoup-active-file)
363 (ignore-errors
364 (load nnsoup-active-file t t t))
365 ;; Be backwards compatible.
366 (when (and nnsoup-group-alist
367 (not (atom (caadar nnsoup-group-alist))))
368 (let ((alist nnsoup-group-alist)
369 entry e min max)
370 (while (setq e (cdr (setq entry (pop alist))))
371 (setq min (caaar e))
372 (setq max (cdar (car (last e))))
373 (setcdr entry (cons (cons min max) (cdr entry)))))
374 (setq nnsoup-group-alist-touched t))
375 nnsoup-group-alist))
376
377(defun nnsoup-write-active-file (&optional force)
378 (when (and nnsoup-group-alist
379 (or force
380 nnsoup-group-alist-touched))
381 (setq nnsoup-group-alist-touched nil)
382 (with-temp-file nnsoup-active-file
383 (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
384 (insert "\n")
385 (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
386 (insert "\n"))))
387
388(defun nnsoup-next-prefix ()
389 "Return the next free prefix."
390 (let (prefix)
391 (while (or (file-exists-p
392 (nnsoup-file (setq prefix (int-to-string
393 nnsoup-current-prefix))))
394 (file-exists-p (nnsoup-file prefix t)))
395 (incf nnsoup-current-prefix))
396 (incf nnsoup-current-prefix)
397 prefix))
398
399(defun nnsoup-file-name (dir file)
400 "Return the full name of FILE (in any case) in DIR."
401 (let* ((case-fold-search t)
402 (files (directory-files dir t))
403 (regexp (concat (regexp-quote file) "$")))
404 (car (delq nil
405 (mapcar
406 (lambda (file)
407 (if (string-match regexp file)
408 file
409 nil))
410 files)))))
411
412(defun nnsoup-read-areas ()
413 (let ((areas-file (nnsoup-file-name nnsoup-tmp-directory "areas")))
414 (when areas-file
415 (save-excursion
416 (set-buffer nntp-server-buffer)
417 (let ((areas (gnus-soup-parse-areas areas-file))
418 entry number area lnum cur-prefix file)
419 ;; Go through all areas in the new AREAS file.
420 (while (setq area (pop areas))
421 ;; Change the name to the permanent name and move the files.
422 (setq cur-prefix (nnsoup-next-prefix))
423 (nnheader-message 5 "Incorporating file %s..." cur-prefix)
424 (when (file-exists-p
425 (setq file
426 (expand-file-name
427 (concat (gnus-soup-area-prefix area) ".IDX")
428 nnsoup-tmp-directory)))
429 (rename-file file (nnsoup-file cur-prefix)))
430 (when (file-exists-p
431 (setq file (expand-file-name
432 (concat (gnus-soup-area-prefix area) ".MSG")
433 nnsoup-tmp-directory)))
434 (rename-file file (nnsoup-file cur-prefix t))
435 (gnus-soup-set-area-prefix area cur-prefix)
436 ;; Find the number of new articles in this area.
437 (setq number (nnsoup-number-of-articles area))
438 (if (not (setq entry (assoc (gnus-soup-area-name area)
439 nnsoup-group-alist)))
440 ;; If this is a new area (group), we just add this info to
441 ;; the group alist.
442 (push (list (gnus-soup-area-name area)
443 (cons 1 number)
444 (list (cons 1 number) area))
445 nnsoup-group-alist)
446 ;; There are already articles in this group, so we add this
447 ;; info to the end of the entry.
448 (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry)))
449 (+ lnum number))
450 area)))
451 (setcdr (cadr entry) (+ lnum number))))))
452 (nnsoup-write-active-file t)
453 (delete-file areas-file)))))
454
455(defun nnsoup-number-of-articles (area)
456 (save-excursion
457 (cond
458 ;; If the number is in the area info, we just return it.
459 ((gnus-soup-area-number area)
460 (gnus-soup-area-number area))
461 ;; If there is an index file, we just count the lines.
462 ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n)
463 (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
464 (count-lines (point-min) (point-max)))
465 ;; We do it the hard way - re-searching through the message
466 ;; buffer.
467 (t
468 (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
469 (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist)
470 (nnsoup-dissect-buffer area))
471 (length (cdr (assoc (gnus-soup-area-prefix area)
472 nnsoup-article-alist)))))))
473
474(defun nnsoup-dissect-buffer (area)
475 (let ((mbox-delim (concat "^" message-unix-mail-delimiter))
476 (format (gnus-soup-encoding-format (gnus-soup-area-encoding area)))
477 (i 0)
478 alist len)
479 (goto-char (point-min))
480 (cond
481 ;; rnews batch format
482 ((or (= format ?u)
483 (= format ?n)) ;; Gnus back compatibility.
484 (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$")
485 (forward-line 1)
486 (push (list
487 (incf i) (point)
488 (progn
489 (forward-char (string-to-number (match-string 1)))
490 (point)))
491 alist)))
492 ;; Unix mbox format
493 ((= format ?m)
494 (while (looking-at mbox-delim)
495 (forward-line 1)
496 (push (list
497 (incf i) (point)
498 (progn
499 (if (re-search-forward mbox-delim nil t)
500 (beginning-of-line)
501 (goto-char (point-max)))
502 (point)))
503 alist)))
504 ;; MMDF format
505 ((= format ?M)
506 (while (looking-at "\^A\^A\^A\^A\n")
507 (forward-line 1)
508 (push (list
509 (incf i) (point)
510 (progn
511 (if (search-forward "\n\^A\^A\^A\^A\n" nil t)
512 (beginning-of-line)
513 (goto-char (point-max)))
514 (point)))
515 alist)))
516 ;; Binary format
517 ((or (= format ?B) (= format ?b))
518 (while (not (eobp))
519 (setq len (+ (* (char-after (point)) (expt 2.0 24))
520 (* (char-after (+ (point) 1)) (expt 2 16))
521 (* (char-after (+ (point) 2)) (expt 2 8))
522 (char-after (+ (point) 3))))
523 (push (list
524 (incf i) (+ (point) 4)
525 (progn
526 (forward-char (floor (+ len 4)))
527 (point)))
528 alist)))
529 (t
530 (error "Unknown format: %c" format)))
531 (push (cons (gnus-soup-area-prefix area) alist) nnsoup-article-alist)))
532
533(defun nnsoup-index-buffer (prefix &optional message)
534 (let* ((file (concat prefix (if message ".MSG" ".IDX")))
535 (buffer-name (concat " *nnsoup " file "*")))
536 (or (get-buffer buffer-name) ; File already loaded.
537 (when (file-exists-p (expand-file-name file nnsoup-directory))
538 (save-excursion ; Load the file.
539 (set-buffer (get-buffer-create buffer-name))
540 (buffer-disable-undo)
541 (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
542 (nnheader-insert-file-contents
543 (expand-file-name file nnsoup-directory))
544 (current-buffer))))))
545
546(defun nnsoup-file (prefix &optional message)
547 (expand-file-name
548 (concat prefix (if message ".MSG" ".IDX"))
549 nnsoup-directory))
550
551(defun nnsoup-message-buffer (prefix)
552 (nnsoup-index-buffer prefix 'msg))
553
554(defun nnsoup-unpack-packets ()
555 "Unpack all packets in `nnsoup-packet-directory'."
556 (let ((packets (directory-files
557 nnsoup-packet-directory t nnsoup-packet-regexp)))
558 (dolist (packet packets)
559 (nnheader-message 5 "nnsoup: unpacking %s..." packet)
560 (if (not (gnus-soup-unpack-packet
561 nnsoup-tmp-directory nnsoup-unpacker packet))
562 (nnheader-message 5 "Couldn't unpack %s" packet)
563 (delete-file packet)
564 (nnsoup-read-areas)
565 (nnheader-message 5 "Unpacking...done")))))
566
567(defun nnsoup-narrow-to-article (article &optional area head)
568 (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
569 (prefix (and area (gnus-soup-area-prefix (nth 1 area))))
570 (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg)))
571 beg end)
572 (when area
573 (save-excursion
574 (cond
575 ;; There is no MSG file.
576 ((null msg-buf)
577 nil)
578 ;; We use the index file to find out where the article
579 ;; begins and ends.
580 ((and (= (gnus-soup-encoding-index
581 (gnus-soup-area-encoding (nth 1 area)))
582 ?c)
583 (file-exists-p (nnsoup-file prefix)))
584 (set-buffer (nnsoup-index-buffer prefix))
585 (widen)
586 (goto-char (point-min))
587 (forward-line (- article (caar area)))
588 (setq beg (read (current-buffer)))
589 (forward-line 1)
590 (if (looking-at "[0-9]+")
591 (progn
592 (setq end (read (current-buffer)))
593 (set-buffer msg-buf)
594 (widen)
595 (let ((format (gnus-soup-encoding-format
596 (gnus-soup-area-encoding (nth 1 area)))))
597 (goto-char end)
598 (when (or (= format ?u) (= format ?n) (= format ?m))
599 (setq end (progn (forward-line -1) (point))))))
600 (set-buffer msg-buf))
601 (widen)
602 (narrow-to-region beg (or end (point-max))))
603 (t
604 (set-buffer msg-buf)
605 (widen)
606 (unless (assoc (gnus-soup-area-prefix (nth 1 area))
607 nnsoup-article-alist)
608 (nnsoup-dissect-buffer (nth 1 area)))
609 (let ((entry (assq article (cdr (assoc (gnus-soup-area-prefix
610 (nth 1 area))
611 nnsoup-article-alist)))))
612 (when entry
613 (narrow-to-region (cadr entry) (caddr entry))))))
614 (goto-char (point-min))
615 (if (not head)
616 ()
617 (narrow-to-region
618 (point-min)
619 (if (search-forward "\n\n" nil t)
620 (1- (point))
621 (point-max))))
622 msg-buf))))
623
624;;;###autoload
625(defun nnsoup-pack-replies ()
626 "Make an outbound package of SOUP replies."
627 (interactive)
628 (unless (file-exists-p nnsoup-replies-directory)
629 (nnheader-message 5 "No such directory: %s" nnsoup-replies-directory))
630 ;; Write all data buffers.
631 (gnus-soup-save-areas)
632 ;; Write the active file.
633 (nnsoup-write-active-file)
634 ;; Write the REPLIES file.
635 (nnsoup-write-replies)
636 ;; Check whether there is anything here.
637 (when (null (directory-files nnsoup-replies-directory nil "\\.MSG$"))
638 (error "No files to pack"))
639 ;; Pack all these files into a SOUP packet.
640 (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
641
642(defun nnsoup-write-replies ()
643 "Write the REPLIES file."
644 (when nnsoup-replies-list
645 (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)
646 (setq nnsoup-replies-list nil)))
647
648(defun nnsoup-article-to-area (article group)
649 "Return the area that ARTICLE in GROUP is located in."
650 (let ((areas (cddr (assoc group nnsoup-group-alist))))
651 (while (and areas (< (cdar (car areas)) article))
652 (setq areas (cdr areas)))
653 (and areas (car areas))))
654
655(defvar nnsoup-old-functions
656 (list message-send-mail-real-function message-send-news-function))
657
658;;;###autoload
659(defun nnsoup-set-variables ()
660 "Use the SOUP methods for posting news and mailing mail."
661 (interactive)
662 (setq message-send-news-function 'nnsoup-request-post)
663 (setq message-send-mail-real-function 'nnsoup-request-mail))
664
665;;;###autoload
666(defun nnsoup-revert-variables ()
667 "Revert posting and mailing methods to the standard Emacs methods."
668 (interactive)
669 (setq message-send-mail-real-function (car nnsoup-old-functions))
670 (setq message-send-news-function (cadr nnsoup-old-functions)))
671
672(defun nnsoup-store-reply (kind)
673 ;; Mostly stolen from `message.el'.
674 (require 'mail-utils)
675 (let ((tembuf (generate-new-buffer " message temp"))
676 (case-fold-search nil)
677 delimline
678 (mailbuf (current-buffer)))
679 (unwind-protect
680 (save-excursion
681 (save-restriction
682 (message-narrow-to-headers)
683 (if (equal kind "mail")
684 (message-generate-headers message-required-mail-headers)
685 (message-generate-headers message-required-news-headers)))
686 (set-buffer tembuf)
687 (erase-buffer)
688 (insert-buffer-substring mailbuf)
689 ;; Remove some headers.
690 (save-restriction
691 (message-narrow-to-headers)
692 ;; Remove some headers.
693 (message-remove-header message-ignored-mail-headers t))
694 (goto-char (point-max))
695 ;; require one newline at the end.
696 (or (= (preceding-char) ?\n)
697 (insert ?\n))
698 (let ((case-fold-search t))
699 ;; Change header-delimiter to be what sendmail expects.
700 (goto-char (point-min))
701 (re-search-forward
702 (concat "^" (regexp-quote mail-header-separator) "\n"))
703 (replace-match "\n")
704 (backward-char 1)
705 (setq delimline (point-marker))
706 (goto-char (1+ delimline))
707 (let ((msg-buf
708 (gnus-soup-store
709 nnsoup-replies-directory
710 (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
711 nnsoup-replies-index-type))
712 (num 0))
713 (when (and msg-buf (bufferp msg-buf))
714 (save-excursion
715 (set-buffer msg-buf)
716 (goto-char (point-min))
717 (while (re-search-forward "^#! *rnews" nil t)
718 (incf num))
719 (when nnsoup-always-save
720 (save-buffer)))
721 (nnheader-message 5 "Stored %d messages" num)))
722 (nnsoup-write-replies)
723 (kill-buffer tembuf))))))
724
725(defun nnsoup-kind-to-prefix (kind)
726 (unless nnsoup-replies-list
727 (setq nnsoup-replies-list
728 (gnus-soup-parse-replies
729 (expand-file-name "REPLIES" nnsoup-replies-directory))))
730 (let ((replies nnsoup-replies-list))
731 (while (and replies
732 (not (string= kind (gnus-soup-reply-kind (car replies)))))
733 (setq replies (cdr replies)))
734 (if replies
735 (gnus-soup-reply-prefix (car replies))
736 (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
737 kind
738 (format "%c%c%c"
739 nnsoup-replies-format-type
740 nnsoup-replies-index-type
741 (if (string= kind "news")
742 ?n ?m)))
743 nnsoup-replies-list)
744 (gnus-soup-reply-prefix (car nnsoup-replies-list)))))
745
746(defun nnsoup-make-active ()
747 "(Re-)create the SOUP active file."
748 (interactive)
749 (let ((files (sort (directory-files nnsoup-directory t "IDX$")
750 (lambda (f1 f2)
751 (< (progn (string-match "/\\([0-9]+\\)\\." f1)
752 (string-to-number (match-string 1 f1)))
753 (progn (string-match "/\\([0-9]+\\)\\." f2)
754 (string-to-number (match-string 1 f2)))))))
755 active group lines ident elem min)
756 (set-buffer (get-buffer-create " *nnsoup work*"))
757 (dolist (file files)
758 (nnheader-message 5 "Doing %s..." file)
759 (erase-buffer)
760 (nnheader-insert-file-contents file)
761 (goto-char (point-min))
762 (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))
763 (setq group "unknown")
764 (setq group (match-string 2)))
765 (setq lines (count-lines (point-min) (point-max)))
766 (setq ident (progn (string-match
767 "/\\([0-9]+\\)\\." file)
768 (match-string 1 file)))
769 (if (not (setq elem (assoc group active)))
770 (push (list group (cons 1 lines)
771 (list (cons 1 lines)
772 (vector ident group "ucm" "" lines)))
773 active)
774 (nconc elem
775 (list
776 (list (cons (1+ (setq min (cdadr elem)))
777 (+ min lines))
778 (vector ident group "ucm" "" lines))))
779 (setcdr (cadr elem) (+ min lines))))
780 (nnheader-message 5 "")
781 (setq nnsoup-group-alist active)
782 (nnsoup-write-active-file t)))
783
784(defun nnsoup-delete-unreferenced-message-files ()
785 "Delete any *.MSG and *.IDX files that aren't known by nnsoup."
786 (interactive)
787 (let* ((known (apply 'nconc (mapcar
788 (lambda (ga)
789 (mapcar
790 (lambda (area)
791 (gnus-soup-area-prefix (cadr area)))
792 (cddr ga)))
793 nnsoup-group-alist)))
794 (regexp "\\.MSG$\\|\\.IDX$")
795 (files (directory-files nnsoup-directory nil regexp))
796 non-files)
797 ;; Find all files that aren't known by nnsoup.
798 (dolist (file files)
799 (string-match regexp file)
800 (unless (member (substring file 0 (match-beginning 0)) known)
801 (push file non-files)))
802 ;; Sort and delete the files.
803 (setq non-files (sort non-files 'string<))
804 (map-y-or-n-p "Delete file %s? "
805 (lambda (file) (delete-file
806 (expand-file-name file nnsoup-directory)))
807 non-files)))
808
809(provide 'nnsoup)
810
811;; arch-tag: b0451389-5703-4450-9425-f66f6b38c828
812;;; nnsoup.el ends here
diff --git a/lisp/gnus/nnultimate.el b/lisp/gnus/nnultimate.el
deleted file mode 100644
index e65d30f2758..00000000000
--- a/lisp/gnus/nnultimate.el
+++ /dev/null
@@ -1,480 +0,0 @@
1;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system
2
3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7;; Keywords: news
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; Note: You need to have `url' and `w3' installed for this
27;; backend to work.
28
29;;; Code:
30
31(eval-when-compile (require 'cl))
32
33(require 'nnoo)
34(require 'message)
35(require 'gnus-util)
36(require 'gnus)
37(require 'nnmail)
38(require 'mm-util)
39(require 'mm-url)
40(require 'nnweb)
41(require 'parse-time)
42(autoload 'w3-parse-buffer "w3-parse")
43
44(nnoo-declare nnultimate)
45
46(defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/")
47 "Where nnultimate will save its files.")
48
49(defvoo nnultimate-address ""
50 "The address of the Ultimate bulletin board.")
51
52;;; Internal variables
53
54(defvar nnultimate-groups-alist nil)
55(defvoo nnultimate-groups nil)
56(defvoo nnultimate-headers nil)
57(defvoo nnultimate-articles nil)
58(defvar nnultimate-table-regexp
59 "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio")
60
61;;; Interface functions
62
63(nnoo-define-basics nnultimate)
64
65(deffoo nnultimate-retrieve-headers (articles &optional group server fetch-old)
66 (nnultimate-possibly-change-server group server)
67 (unless gnus-nov-is-evil
68 (let* ((last (car (last articles)))
69 (did nil)
70 (start 1)
71 (entry (assoc group nnultimate-groups))
72 (sid (nth 2 entry))
73 (topics (nth 4 entry))
74 (mapping (nth 5 entry))
75 (old-total (or (nth 6 entry) 1))
76 (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000")
77 (furls (list (concat nnultimate-address (format furl sid))))
78 (nnultimate-table-regexp
79 "postings.*editpost\\|forumdisplay\\|getbio")
80 headers article subject score from date lines parent point
81 contents tinfo fetchers map elem a href garticles topic old-max
82 inc datel table current-page total-contents pages
83 farticles forum-contents parse furl-fetched mmap farticle)
84 (setq map mapping)
85 (while (and (setq article (car articles))
86 map)
87 ;; Skip past the articles in the map until we reach the
88 ;; article we're looking for.
89 (while (and map
90 (or (> article (caar map))
91 (< (cadar map) (caar map))))
92 (pop map))
93 (when (setq mmap (car map))
94 (setq farticle -1)
95 (while (and article
96 (<= article (nth 1 mmap)))
97 ;; Do we already have a fetcher for this topic?
98 (if (setq elem (assq (nth 2 mmap) fetchers))
99 ;; Yes, so we just add the spec to the end.
100 (nconc elem (list (cons article
101 (+ (nth 3 mmap) (incf farticle)))))
102 ;; No, so we add a new one.
103 (push (list (nth 2 mmap)
104 (cons article
105 (+ (nth 3 mmap) (incf farticle))))
106 fetchers))
107 (pop articles)
108 (setq article (car articles)))))
109 ;; Now we have the mapping from/to Gnus/nnultimate article numbers,
110 ;; so we start fetching the topics that we need to satisfy the
111 ;; request.
112 (if (not fetchers)
113 (save-excursion
114 (set-buffer nntp-server-buffer)
115 (erase-buffer))
116 (setq nnultimate-articles nil)
117 (mm-with-unibyte-buffer
118 (dolist (elem fetchers)
119 (setq pages 1
120 current-page 1
121 total-contents nil)
122 (while (<= current-page pages)
123 (erase-buffer)
124 (setq subject (nth 2 (assq (car elem) topics)))
125 (setq href (nth 3 (assq (car elem) topics)))
126 (if (= current-page 1)
127 (mm-url-insert href)
128 (string-match "\\.html$" href)
129 (mm-url-insert (concat (substring href 0 (match-beginning 0))
130 "-" (number-to-string current-page)
131 (match-string 0 href))))
132 (goto-char (point-min))
133 (setq contents
134 (ignore-errors (w3-parse-buffer (current-buffer))))
135 (setq table (nnultimate-find-forum-table contents))
136 (goto-char (point-min))
137 (when (re-search-forward "topic is \\([0-9]+\\) pages" nil t)
138 (setq pages (string-to-number (match-string 1))))
139 (setq contents (cdr (nth 2 (car (nth 2 table)))))
140 (setq total-contents (nconc total-contents contents))
141 (incf current-page))
142 (when t
143 (let ((i 0))
144 (dolist (co total-contents)
145 (push (list (or (nnultimate-topic-article-to-article
146 group (car elem) (incf i))
147 1)
148 co subject)
149 nnultimate-articles))))
150 (when nil
151 (dolist (art (cdr elem))
152 (when (nth (1- (cdr art)) total-contents)
153 (push (list (car art)
154 (nth (1- (cdr art)) total-contents)
155 subject)
156 nnultimate-articles))))))
157 (setq nnultimate-articles
158 (sort nnultimate-articles 'car-less-than-car))
159 ;; Now we have all the articles, conveniently in an alist
160 ;; where the key is the Gnus article number.
161 (dolist (articlef nnultimate-articles)
162 (setq article (nth 0 articlef)
163 contents (nth 1 articlef)
164 subject (nth 2 articlef))
165 (setq from (mapconcat 'identity
166 (nnweb-text (car (nth 2 contents)))
167 " ")
168 datel (nnweb-text (nth 2 (car (cdr (nth 2 contents))))))
169 (while datel
170 (when (string-match "Posted" (car datel))
171 (setq date (substring (car datel) (match-end 0))
172 datel nil))
173 (pop datel))
174 (when date
175 (setq date (delete "" (split-string date "[-, \n\t\r    ]")))
176 (setq date
177 (if (or (member "AM" date)
178 (member "PM" date))
179 (format
180 "%s %s %s %s"
181 (nth 1 date)
182 (if (and (>= (length (nth 0 date)) 3)
183 (assoc (downcase
184 (substring (nth 0 date) 0 3))
185 parse-time-months))
186 (substring (nth 0 date) 0 3)
187 (car (rassq (string-to-number (nth 0 date))
188 parse-time-months)))
189 (nth 2 date) (nth 3 date))
190 (format "%s %s %s %s"
191 (car (rassq (string-to-number (nth 1 date))
192 parse-time-months))
193 (nth 0 date) (nth 2 date) (nth 3 date)))))
194 (push
195 (cons
196 article
197 (make-full-mail-header
198 article subject
199 from (or date "")
200 (concat "<" (number-to-string sid) "%"
201 (number-to-string article)
202 "@ultimate." server ">")
203 "" 0
204 (/ (length (mapconcat
205 'identity
206 (nnweb-text
207 (cdr (nth 2 (nth 1 (nth 2 contents)))))
208 ""))
209 70)
210 nil nil))
211 headers))
212 (setq nnultimate-headers (sort headers 'car-less-than-car))
213 (save-excursion
214 (set-buffer nntp-server-buffer)
215 (mm-with-unibyte-current-buffer
216 (erase-buffer)
217 (dolist (header nnultimate-headers)
218 (nnheader-insert-nov (cdr header))))))
219 'nov)))
220
221(defun nnultimate-topic-article-to-article (group topic article)
222 (catch 'found
223 (dolist (elem (nth 5 (assoc group nnultimate-groups)))
224 (when (and (= topic (nth 2 elem))
225 (>= article (nth 3 elem))
226 (< article (+ (- (nth 1 elem) (nth 0 elem)) 1
227 (nth 3 elem))))
228 (throw 'found
229 (+ (nth 0 elem) (- article (nth 3 elem))))))))
230
231(deffoo nnultimate-request-group (group &optional server dont-check)
232 (nnultimate-possibly-change-server nil server)
233 (when (not nnultimate-groups)
234 (nnultimate-request-list))
235 (unless dont-check
236 (nnultimate-create-mapping group))
237 (let ((elem (assoc group nnultimate-groups)))
238 (cond
239 ((not elem)
240 (nnheader-report 'nnultimate "Group does not exist"))
241 (t
242 (nnheader-report 'nnultimate "Opened group %s" group)
243 (nnheader-insert
244 "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
245 (prin1-to-string group))))))
246
247(deffoo nnultimate-request-close ()
248 (setq nnultimate-groups-alist nil
249 nnultimate-groups nil))
250
251(deffoo nnultimate-request-article (article &optional group server buffer)
252 (nnultimate-possibly-change-server group server)
253 (let ((contents (cdr (assq article nnultimate-articles))))
254 (setq contents (cddr (nth 2 (nth 1 (nth 2 (car contents))))))
255 (when contents
256 (save-excursion
257 (set-buffer (or buffer nntp-server-buffer))
258 (erase-buffer)
259 (nnweb-insert-html (cons 'p (cons nil (list contents))))
260 (goto-char (point-min))
261 (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
262 (let ((header (cdr (assq article nnultimate-headers))))
263 (mm-with-unibyte-current-buffer
264 (nnheader-insert-header header)))
265 (nnheader-report 'nnultimate "Fetched article %s" article)
266 (cons group article)))))
267
268(deffoo nnultimate-request-list (&optional server)
269 (nnultimate-possibly-change-server nil server)
270 (mm-with-unibyte-buffer
271 (mm-url-insert
272 (if (string-match "/$" nnultimate-address)
273 (concat nnultimate-address "Ultimate.cgi")
274 nnultimate-address))
275 (let ((contents (nth 2 (car (nth 2
276 (nnultimate-find-forum-table
277 (w3-parse-buffer (current-buffer)))))))
278 sid elem description articles a href group forum
279 a1 a2)
280 (dolist (row contents)
281 (setq row (nth 2 row))
282 (when (setq a (nnweb-parse-find 'a row))
283 (setq group (car (last (nnweb-text a)))
284 href (cdr (assq 'href (nth 1 a))))
285 (setq description (car (last (nnweb-text (nth 1 row)))))
286 (setq a1 (car (last (nnweb-text (nth 2 row)))))
287 (setq a2 (car (last (nnweb-text (nth 3 row)))))
288 (when (string-match "^[0-9]+$" a1)
289 (setq articles (string-to-number a1)))
290 (when (and a2 (string-match "^[0-9]+$" a2))
291 (setq articles (max articles (string-to-number a2))))
292 (when href
293 (string-match "number=\\([0-9]+\\)" href)
294 (setq forum (string-to-number (match-string 1 href)))
295 (if (setq elem (assoc group nnultimate-groups))
296 (setcar (cdr elem) articles)
297 (push (list group articles forum description nil nil nil nil)
298 nnultimate-groups))))))
299 (nnultimate-write-groups)
300 (nnultimate-generate-active)
301 t))
302
303(deffoo nnultimate-request-newgroups (date &optional server)
304 (nnultimate-possibly-change-server nil server)
305 (nnultimate-generate-active)
306 t)
307
308(nnoo-define-skeleton nnultimate)
309
310;;; Internal functions
311
312(defun nnultimate-prune-days (group time)
313 "Compute the number of days to fetch info for."
314 (let ((old-time (nth 7 (assoc group nnultimate-groups))))
315 (if (null old-time)
316 1000
317 (- (time-to-days time) (time-to-days old-time)))))
318
319(defun nnultimate-create-mapping (group)
320 (let* ((entry (assoc group nnultimate-groups))
321 (sid (nth 2 entry))
322 (topics (nth 4 entry))
323 (mapping (nth 5 entry))
324 (old-total (or (nth 6 entry) 1))
325 (current-time (current-time))
326 (furl
327 (concat "forumdisplay.cgi?action=topics&number=%d&DaysPrune="
328 (number-to-string
329 (nnultimate-prune-days group current-time))))
330 (furls (list (concat nnultimate-address (format furl sid))))
331 contents forum-contents furl-fetched a subject href
332 garticles topic tinfo old-max inc parse)
333 (mm-with-unibyte-buffer
334 (while furls
335 (erase-buffer)
336 (mm-url-insert (pop furls))
337 (goto-char (point-min))
338 (setq parse (w3-parse-buffer (current-buffer)))
339 (setq contents
340 (cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table
341 parse))))))
342 (setq forum-contents (nconc contents forum-contents))
343 (unless furl-fetched
344 (setq furl-fetched t)
345 ;; On the first time through this loop, we find all the
346 ;; forum URLs.
347 (dolist (a (nnweb-parse-find-all 'a parse))
348 (let ((href (cdr (assq 'href (nth 1 a)))))
349 (when (and href
350 (string-match "forumdisplay.*startpoint" href))
351 (push href furls))))
352 (setq furls (nreverse furls))))
353 ;; The main idea here is to map Gnus article numbers to
354 ;; nnultimate article numbers. Say there are three topics in
355 ;; this forum, the first with 4 articles, the seconds with 2,
356 ;; and the third with 1. Then this will translate into 7 Gnus
357 ;; article numbers, where 1-4 comes from the first topic, 5-6
358 ;; from the second and 7 from the third. Now, then next time
359 ;; the group is entered, there's 2 new articles in topic one
360 ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6
361 ;; in topic one and 10 will be the 2 in topic three.
362 (dolist (row (nreverse forum-contents))
363 (setq row (nth 2 row))
364 (when (setq a (nnweb-parse-find 'a row))
365 (setq subject (car (last (nnweb-text a)))
366 href (cdr (assq 'href (nth 1 a))))
367 (let ((artlist (nreverse (nnweb-text row)))
368 art)
369 (while (and (not art)
370 artlist)
371 (when (string-match "^[0-9]+$" (car artlist))
372 (setq art (1+ (string-to-number (car artlist)))))
373 (pop artlist))
374 (setq garticles art))
375 (when garticles
376 (string-match "/\\([0-9]+\\).html" href)
377 (setq topic (string-to-number (match-string 1 href)))
378 (if (setq tinfo (assq topic topics))
379 (progn
380 (setq old-max (cadr tinfo))
381 (setcar (cdr tinfo) garticles))
382 (setq old-max 0)
383 (push (list topic garticles subject href) topics)
384 (setcar (nthcdr 4 entry) topics))
385 (when (not (= old-max garticles))
386 (setq inc (- garticles old-max))
387 (setq mapping (nconc mapping
388 (list
389 (list
390 old-total (1- (incf old-total inc))
391 topic (1+ old-max)))))
392 (incf old-max inc)
393 (setcar (nthcdr 5 entry) mapping)
394 (setcar (nthcdr 6 entry) old-total))))))
395 (setcar (nthcdr 7 entry) current-time)
396 (setcar (nthcdr 1 entry) (1- old-total))
397 (nnultimate-write-groups)
398 mapping))
399
400(defun nnultimate-possibly-change-server (&optional group server)
401 (nnultimate-init server)
402 (when (and server
403 (not (nnultimate-server-opened server)))
404 (nnultimate-open-server server))
405 (unless nnultimate-groups-alist
406 (nnultimate-read-groups)
407 (setq nnultimate-groups (cdr (assoc nnultimate-address
408 nnultimate-groups-alist)))))
409
410(deffoo nnultimate-open-server (server &optional defs connectionless)
411 (nnheader-init-server-buffer)
412 (if (nnultimate-server-opened server)
413 t
414 (unless (assq 'nnultimate-address defs)
415 (setq defs (append defs (list (list 'nnultimate-address server)))))
416 (nnoo-change-server 'nnultimate server defs)))
417
418(defun nnultimate-read-groups ()
419 (setq nnultimate-groups-alist nil)
420 (let ((file (expand-file-name "groups" nnultimate-directory)))
421 (when (file-exists-p file)
422 (mm-with-unibyte-buffer
423 (insert-file-contents file)
424 (goto-char (point-min))
425 (setq nnultimate-groups-alist (read (current-buffer)))))))
426
427(defun nnultimate-write-groups ()
428 (setq nnultimate-groups-alist
429 (delq (assoc nnultimate-address nnultimate-groups-alist)
430 nnultimate-groups-alist))
431 (push (cons nnultimate-address nnultimate-groups)
432 nnultimate-groups-alist)
433 (with-temp-file (expand-file-name "groups" nnultimate-directory)
434 (prin1 nnultimate-groups-alist (current-buffer))))
435
436(defun nnultimate-init (server)
437 "Initialize buffers and such."
438 (unless (file-exists-p nnultimate-directory)
439 (gnus-make-directory nnultimate-directory)))
440
441(defun nnultimate-generate-active ()
442 (save-excursion
443 (set-buffer nntp-server-buffer)
444 (erase-buffer)
445 (dolist (elem nnultimate-groups)
446 (insert (prin1-to-string (car elem))
447 " " (number-to-string (cadr elem)) " 1 y\n"))))
448
449(defun nnultimate-find-forum-table (contents)
450 (catch 'found
451 (nnultimate-find-forum-table-1 contents)))
452
453(defun nnultimate-find-forum-table-1 (contents)
454 (dolist (element contents)
455 (unless (stringp element)
456 (when (and (eq (car element) 'table)
457 (nnultimate-forum-table-p element))
458 (throw 'found element))
459 (when (nth 2 element)
460 (nnultimate-find-forum-table-1 (nth 2 element))))))
461
462(defun nnultimate-forum-table-p (parse)
463 (when (not (apply 'gnus-or
464 (mapcar
465 (lambda (p)
466 (nnweb-parse-find 'table p))
467 (nth 2 parse))))
468 (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
469 case-fold-search)
470 (when (and href (string-match nnultimate-table-regexp href))
471 t))))
472
473(provide 'nnultimate)
474
475;; Local Variables:
476;; coding: iso-8859-1
477;; End:
478
479;; arch-tag: ab6bfc45-8fe1-4647-9c78-41050eb152b8
480;;; nnultimate.el ends here