diff options
| author | Katsumi Yamaoka | 2010-08-31 23:55:50 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2010-08-31 23:55:50 +0000 |
| commit | c4d82de839ead8d8b534ad11d14edc11d1ddbdb4 (patch) | |
| tree | 8a228d4c6a1469b36412ca151a798ca66860cb5b | |
| parent | 51dee5ef43bc84f1d45657c293a2ccb7ae7e1b0a (diff) | |
| download | emacs-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.texi | 336 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/gnus/gnus-group.el | 14 | ||||
| -rw-r--r-- | lisp/gnus/gnus-soup.el | 611 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 15 | ||||
| -rw-r--r-- | lisp/gnus/gnus.el | 6 | ||||
| -rw-r--r-- | lisp/gnus/nnsoup.el | 812 | ||||
| -rw-r--r-- | lisp/gnus/nnultimate.el | 480 |
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 | ||
| 720 | Document Groups | 718 | Document 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 | ||
| 724 | SOUP | ||
| 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 | |||
| 730 | Combined Groups | 722 | Combined 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 |
| 6851 | Canceled article (@code{gnus-canceled-mark}) | 6843 | Canceled 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 |
| 6859 | Sparsely reffed article (@code{gnus-sparse-mark}). @xref{Customizing | 6847 | Sparsely 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 | |||
| 7824 | intended for those non-news newsgroups where the back end has to fetch | 7812 | intended for those non-news newsgroups where the back end has to fetch |
| 7825 | quite a lot to present the summary buffer, and where it's impossible to | 7813 | quite a lot to present the summary buffer, and where it's impossible to |
| 7826 | go back to parents of articles. This is mostly the case in the | 7814 | go back to parents of articles. This is mostly the case in the |
| 7827 | web-based groups, like the @code{nnultimate} groups. | 7815 | web-based groups. |
| 7828 | 7816 | ||
| 7829 | If you don't use those, then it's safe to leave this as the default | 7817 | If 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 | ||
| 17560 | probably the most popular Web bulletin board system used. It has a | ||
| 17561 | quite regular and nice interface, and it's possible to get the | ||
| 17562 | information Gnus needs to keep groups updated. | ||
| 17563 | |||
| 17564 | The easiest way to get started with @code{nnultimate} is to say | ||
| 17565 | something like the following in the group buffer: @kbd{B nnultimate RET | ||
| 17566 | http://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 | ||
| 17568 | you're interested in; there's quite a list of them on the Ultimate web | ||
| 17569 | site.) Then subscribe to the groups you're interested in from the | ||
| 17570 | server buffer, and read them from the group buffer. | ||
| 17571 | |||
| 17572 | The following @code{nnultimate} variables can be altered: | ||
| 17573 | |||
| 17574 | @table @code | ||
| 17575 | @item nnultimate-directory | ||
| 17576 | @vindex nnultimate-directory | ||
| 17577 | The 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 | |||
| 18920 | means low probability with @samp{0} being the lowest valid number. | 18878 | means 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 | |||
| 18928 | In the PC world people often talk about ``offline'' newsreaders. These | ||
| 18929 | are thingies that are combined reader/news transport monstrosities. | ||
| 18930 | With built-in modem programs. Yecchh! | ||
| 18931 | |||
| 18932 | Of 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 | ||
| 18934 | transport things like Ghod intended. And then we just use normal | ||
| 18935 | newsreaders. | ||
| 18936 | |||
| 18937 | However, it can sometimes be convenient to do something that's a bit | ||
| 18938 | easier on the brain if you have a very slow modem, and you're not really | ||
| 18939 | that interested in doing things properly. | ||
| 18940 | |||
| 18941 | A file format called @sc{soup} has been developed for transporting news | ||
| 18942 | and mail from servers to home machines and back again. It can be a bit | ||
| 18943 | fiddly. | ||
| 18944 | |||
| 18945 | First some terminology: | ||
| 18946 | |||
| 18947 | @table @dfn | ||
| 18948 | |||
| 18949 | @item server | ||
| 18950 | This is the machine that is connected to the outside world and where you | ||
| 18951 | get news and/or mail from. | ||
| 18952 | |||
| 18953 | @item home machine | ||
| 18954 | This is the machine that you want to do the actual reading and responding | ||
| 18955 | on. It is typically not connected to the rest of the world in any way. | ||
| 18956 | |||
| 18957 | @item packet | ||
| 18958 | Something that contains messages and/or commands. There are two kinds | ||
| 18959 | of packets: | ||
| 18960 | |||
| 18961 | @table @dfn | ||
| 18962 | @item message packets | ||
| 18963 | These are packets made at the server, and typically contain lots of | ||
| 18964 | messages for you to read. These are called @file{SoupoutX.tgz} by | ||
| 18965 | default, where @var{x} is a number. | ||
| 18966 | |||
| 18967 | @item response packets | ||
| 18968 | These are packets made at the home machine, and typically contains | ||
| 18969 | replies that you've written. These are called @file{SoupinX.tgz} by | ||
| 18970 | default, where @var{x} is a number. | ||
| 18971 | |||
| 18972 | @end table | ||
| 18973 | |||
| 18974 | @end table | ||
| 18975 | |||
| 18976 | |||
| 18977 | @enumerate | ||
| 18978 | |||
| 18979 | @item | ||
| 18980 | You log in on the server and create a @sc{soup} packet. You can either | ||
| 18981 | use a dedicated @sc{soup} thingie (like the @code{awk} program), or you | ||
| 18982 | can use Gnus to create the packet with its @sc{soup} commands (@kbd{O | ||
| 18983 | s} and/or @kbd{G s b}; and then @kbd{G s p}) (@pxref{SOUP Commands}). | ||
| 18984 | |||
| 18985 | @item | ||
| 18986 | You transfer the packet home. Rail, boat, car or modem will do fine. | ||
| 18987 | |||
| 18988 | @item | ||
| 18989 | You put the packet in your home directory. | ||
| 18990 | |||
| 18991 | @item | ||
| 18992 | You fire up Gnus on your home machine using the @code{nnsoup} back end as | ||
| 18993 | the native or secondary server. | ||
| 18994 | |||
| 18995 | @item | ||
| 18996 | You read articles and mail and answer and followup to the things you | ||
| 18997 | want (@pxref{SOUP Replies}). | ||
| 18998 | |||
| 18999 | @item | ||
| 19000 | You do the @kbd{G s r} command to pack these replies into a @sc{soup} | ||
| 19001 | packet. | ||
| 19002 | |||
| 19003 | @item | ||
| 19004 | You transfer this packet to the server. | ||
| 19005 | |||
| 19006 | @item | ||
| 19007 | You use Gnus to mail this packet out with the @kbd{G s s} command. | ||
| 19008 | |||
| 19009 | @item | ||
| 19010 | You then repeat until you die. | ||
| 19011 | |||
| 19012 | @end enumerate | ||
| 19013 | |||
| 19014 | So you basically have a bipartite system---you use @code{nnsoup} for | ||
| 19015 | reading 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 | |||
| 19027 | These 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 | ||
| 19033 | Pack all unread articles in the current group | ||
| 19034 | (@code{gnus-group-brew-soup}). This command understands the | ||
| 19035 | process/prefix convention. | ||
| 19036 | |||
| 19037 | @item G s w | ||
| 19038 | @kindex G s w (Group) | ||
| 19039 | @findex gnus-soup-save-areas | ||
| 19040 | Save 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 | ||
| 19045 | Send 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 | ||
| 19051 | Pack 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 | ||
| 19056 | Pack 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 | ||
| 19061 | This summary-mode command adds the current article to a @sc{soup} packet | ||
| 19062 | (@code{gnus-soup-add-article}). It understands the process/prefix | ||
| 19063 | convention (@pxref{Process/Prefix}). | ||
| 19064 | |||
| 19065 | @end table | ||
| 19066 | |||
| 19067 | |||
| 19068 | There are a few variables to customize where Gnus will put all these | ||
| 19069 | thingies: | ||
| 19070 | |||
| 19071 | @table @code | ||
| 19072 | |||
| 19073 | @item gnus-soup-directory | ||
| 19074 | @vindex gnus-soup-directory | ||
| 19075 | Directory 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 | ||
| 19080 | This is what Gnus will use as a temporary directory while sending our | ||
| 19081 | reply packets. @file{~/SoupBrew/SoupReplies/} is the default. | ||
| 19082 | |||
| 19083 | @item gnus-soup-prefix-file | ||
| 19084 | @vindex gnus-soup-prefix-file | ||
| 19085 | Name 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 | ||
| 19090 | A 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 | ||
| 19095 | Format 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 | ||
| 19100 | Where Gnus will look for reply packets. The default is @file{~/}. | ||
| 19101 | |||
| 19102 | @item gnus-soup-packet-regexp | ||
| 19103 | @vindex gnus-soup-packet-regexp | ||
| 19104 | Regular 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 | ||
| 19115 | read incoming packets, unpack them, and put them in a directory where | ||
| 19116 | you can read them at leisure. | ||
| 19117 | |||
| 19118 | These 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 | ||
| 19124 | When @code{nnsoup} unpacks a @sc{soup} packet, it does it in this | ||
| 19125 | directory. (@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. | ||
| 19130 | The default is @file{~/SOUP/}. | ||
| 19131 | |||
| 19132 | @item nnsoup-replies-directory | ||
| 19133 | @vindex nnsoup-replies-directory | ||
| 19134 | All replies will be stored in this directory before being packed into a | ||
| 19135 | reply packet. The default is @file{~/SOUP/replies/}. | ||
| 19136 | |||
| 19137 | @item nnsoup-replies-format-type | ||
| 19138 | @vindex nnsoup-replies-format-type | ||
| 19139 | The @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 | ||
| 19141 | shouldn't even have documented it. Drats! Too late! | ||
| 19142 | |||
| 19143 | @item nnsoup-replies-index-type | ||
| 19144 | @vindex nnsoup-replies-index-type | ||
| 19145 | The index type of the replies packet. The default is @samp{?n}, which | ||
| 19146 | means ``none''. Don't fiddle with this one either! | ||
| 19147 | |||
| 19148 | @item nnsoup-active-file | ||
| 19149 | @vindex nnsoup-active-file | ||
| 19150 | Where @code{nnsoup} stores lots of information. This is not an ``active | ||
| 19151 | file'' in the @code{nntp} sense; it's an Emacs Lisp file. If you lose | ||
| 19152 | this 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 | ||
| 19157 | Format string command for packing a reply @sc{soup} packet. The default | ||
| 19158 | is @samp{tar cf - %s | gzip > $HOME/Soupin%d.tgz}. | ||
| 19159 | |||
| 19160 | @item nnsoup-unpacker | ||
| 19161 | @vindex nnsoup-unpacker | ||
| 19162 | Format string command for unpacking incoming @sc{soup} packets. The | ||
| 19163 | default is @samp{gunzip -c %s | tar xvf -}. | ||
| 19164 | |||
| 19165 | @item nnsoup-packet-directory | ||
| 19166 | @vindex nnsoup-packet-directory | ||
| 19167 | Where @code{nnsoup} will look for incoming packets. The default is | ||
| 19168 | @file{~/}. | ||
| 19169 | |||
| 19170 | @item nnsoup-packet-regexp | ||
| 19171 | @vindex nnsoup-packet-regexp | ||
| 19172 | Regular expression matching incoming @sc{soup} packets. The default is | ||
| 19173 | @samp{Soupout}. | ||
| 19174 | |||
| 19175 | @item nnsoup-always-save | ||
| 19176 | @vindex nnsoup-always-save | ||
| 19177 | If 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 | |||
| 19185 | Just using @code{nnsoup} won't mean that your postings and mailings end | ||
| 19186 | up in @sc{soup} reply packets automagically. You have to work a bit | ||
| 19187 | more for that to happen. | ||
| 19188 | |||
| 19189 | @findex nnsoup-set-variables | ||
| 19190 | The @code{nnsoup-set-variables} command will set the appropriate | ||
| 19191 | variables to ensure that all your followups and replies end up in the | ||
| 19192 | @sc{soup} system. | ||
| 19193 | |||
| 19194 | In 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 | |||
| 19201 | And that's it, really. If you only want news to go into the @sc{soup} | ||
| 19202 | system 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 | |||
| 27927 | else (@pxref{Document Groups}). | 27602 | else (@pxref{Document Groups}). |
| 27928 | 27603 | ||
| 27929 | @item | 27604 | @item |
| 27930 | Gnus has a new back end (@code{nnsoup}) to create/read SOUP packets | 27605 | Gnus has a new back end (@code{nnsoup}) to create/read SOUP packets. |
| 27931 | (@pxref{SOUP}). | ||
| 27932 | 27606 | ||
| 27933 | @item | 27607 | @item |
| 27934 | The Gnus cache is much faster. | 27608 | The 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 |
| 29495 | the 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 @@ | |||
| 1 | 2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> | 1 | 2010-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. | ||
| 64 | The SOUP files will be inserted where the %s is in the string. | ||
| 65 | This string MUST contain both %s and %d. The file number will be | ||
| 66 | inserted 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. | ||
| 73 | The 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 | ||
| 101 | format.") | ||
| 102 | |||
| 103 | (defvar gnus-soup-index-type ?c | ||
| 104 | "*Soup index type. | ||
| 105 | `n' means no index file and `c' means standard Cnews overview | ||
| 106 | format.") | ||
| 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. | ||
| 158 | If N is a positive number, add the N next articles. | ||
| 159 | If N is a negative number, add the N previous articles. | ||
| 160 | If N is nil and any articles have been marked with the process mark, | ||
| 161 | move 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. | ||
| 205 | Uses 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. | ||
| 228 | Will use the remaining command line arguments as regular expressions | ||
| 229 | for matching on group names. | ||
| 230 | |||
| 231 | For instance, if you want to brew on all the nnml groups, as well as | ||
| 232 | groups with \"emacs\" in the name, you could say something like: | ||
| 233 | |||
| 234 | $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\" | ||
| 235 | |||
| 236 | Note -- 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. | ||
| 304 | If 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. | ||
| 397 | The result is a of vectors, each containing one entry from the AREA file. | ||
| 398 | The vector contain five strings, | ||
| 399 | [prefix name encoding description number] | ||
| 400 | though 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. | ||
| 423 | The result is a of vectors, each containing one entry from the REPLIES | ||
| 424 | file. 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. | ||
| 521 | Return 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. |
| 1259 | This is mostly relevant for slow back ends where the user may | 1254 | This is mostly relevant for slow back ends where the user may |
| 1260 | wish to widen the summary buffer to include all headers | 1255 | wish to widen the summary buffer to include all headers |
| 1261 | that were fetched. Say, for nnultimate groups." | 1256 | that 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. | ||
| 63 | The SOUP files will be inserted where the %s is in the string. | ||
| 64 | This string MUST contain both %s and %d. The file number will be | ||
| 65 | inserted where %d appears.") | ||
| 66 | |||
| 67 | (defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -" | ||
| 68 | "*Format string command for unpacking a SOUP packet. | ||
| 69 | The 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. | ||
| 79 | This is necessary if using message mode outside Gnus with nnsoup as a | ||
| 80 | backend 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 | ||