mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-27 07:37:33 +00:00
Remove nnultimate.el and related code; Remove nnsoup.el, gnus-soup.el and related code; by Lars Magne Ingebrigtsen <larsi@gnus.org>.
This commit is contained in:
Katsumi Yamaoka
parent
51dee5ef43
commit
c4d82de839
@ -632,7 +632,7 @@ Select Methods
|
||||
* Getting Mail:: Reading your personal mail with Gnus.
|
||||
* Browsing the Web:: Getting messages from a plethora of Web sources.
|
||||
* IMAP:: Using Gnus as a @acronym{IMAP} client.
|
||||
* Other Sources:: Reading directories, files, SOUP packets.
|
||||
* Other Sources:: Reading directories, files.
|
||||
* Combined Groups:: Combining groups into one group.
|
||||
* Email Based Diary:: Using mails to manage diary events in Gnus.
|
||||
* Gnus Unplugged:: Reading news and mail offline.
|
||||
@ -695,7 +695,6 @@ Browsing the Web
|
||||
|
||||
* Archiving Mail::
|
||||
* Web Searches:: Creating groups from articles that match a string.
|
||||
* Ultimate:: The Ultimate Bulletin Board systems.
|
||||
* Web Archive:: Reading mailing list archived on web.
|
||||
* RSS:: Reading RDF site summary.
|
||||
* Customizing W3:: Doing stuff to Emacs/W3 from Gnus.
|
||||
@ -714,19 +713,12 @@ Other Sources
|
||||
* Directory Groups:: You can read a directory as if it was a newsgroup.
|
||||
* Anything Groups:: Dired? Who needs dired?
|
||||
* Document Groups:: Single files can be the basis of a group.
|
||||
* SOUP:: Reading @sc{soup} packets ``offline''.
|
||||
* Mail-To-News Gateways:: Posting articles via mail-to-news gateways.
|
||||
|
||||
Document Groups
|
||||
|
||||
* Document Server Internals:: How to add your own document types.
|
||||
|
||||
SOUP
|
||||
|
||||
* SOUP Commands:: Commands for creating and sending @sc{soup} packets
|
||||
* SOUP Groups:: A back end for reading @sc{soup} packets.
|
||||
* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news.
|
||||
|
||||
Combined Groups
|
||||
|
||||
* Virtual Groups:: Combining articles from many groups.
|
||||
@ -6850,10 +6842,6 @@ Marked as read by a catchup (@code{gnus-catchup-mark}).
|
||||
@vindex gnus-canceled-mark
|
||||
Canceled article (@code{gnus-canceled-mark})
|
||||
|
||||
@item F
|
||||
@vindex gnus-souped-mark
|
||||
@sc{soup}ed article (@code{gnus-souped-mark}). @xref{SOUP}.
|
||||
|
||||
@item Q
|
||||
@vindex gnus-sparse-mark
|
||||
Sparsely reffed article (@code{gnus-sparse-mark}). @xref{Customizing
|
||||
@ -7824,7 +7812,7 @@ This is a rather obscure variable that few will find useful. It's
|
||||
intended for those non-news newsgroups where the back end has to fetch
|
||||
quite a lot to present the summary buffer, and where it's impossible to
|
||||
go back to parents of articles. This is mostly the case in the
|
||||
web-based groups, like the @code{nnultimate} groups.
|
||||
web-based groups.
|
||||
|
||||
If you don't use those, then it's safe to leave this as the default
|
||||
@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.
|
||||
* Getting Mail:: Reading your personal mail with Gnus.
|
||||
* Browsing the Web:: Getting messages from a plethora of Web sources.
|
||||
* IMAP:: Using Gnus as a @acronym{IMAP} client.
|
||||
* Other Sources:: Reading directories, files, SOUP packets.
|
||||
* Other Sources:: Reading directories, files.
|
||||
* Combined Groups:: Combining groups into one group.
|
||||
* Email Based Diary:: Using mails to manage diary events in Gnus.
|
||||
* Gnus Unplugged:: Reading news and mail offline.
|
||||
@ -17407,7 +17395,6 @@ interfaces to these sources.
|
||||
@menu
|
||||
* Archiving Mail::
|
||||
* Web Searches:: Creating groups from articles that match a string.
|
||||
* Ultimate:: The Ultimate Bulletin Board systems.
|
||||
* Web Archive:: Reading mailing list archived on web.
|
||||
* RSS:: Reading RDF site summary.
|
||||
* Customizing W3:: Doing stuff to Emacs/W3 from Gnus.
|
||||
@ -17551,34 +17538,6 @@ Format string URL to fetch an article by @code{Message-ID}.
|
||||
@end table
|
||||
|
||||
|
||||
@node Ultimate
|
||||
@subsection Ultimate
|
||||
@cindex nnultimate
|
||||
@cindex Ultimate Bulletin Board
|
||||
|
||||
@uref{http://www.ultimatebb.com/, The Ultimate Bulletin Board} is
|
||||
probably the most popular Web bulletin board system used. It has a
|
||||
quite regular and nice interface, and it's possible to get the
|
||||
information Gnus needs to keep groups updated.
|
||||
|
||||
The easiest way to get started with @code{nnultimate} is to say
|
||||
something like the following in the group buffer: @kbd{B nnultimate RET
|
||||
http://www.tcj.com/messboard/ubbcgi/ RET}. (Substitute the @acronym{URL}
|
||||
(not including @samp{Ultimate.cgi} or the like at the end) for a forum
|
||||
you're interested in; there's quite a list of them on the Ultimate web
|
||||
site.) Then subscribe to the groups you're interested in from the
|
||||
server buffer, and read them from the group buffer.
|
||||
|
||||
The following @code{nnultimate} variables can be altered:
|
||||
|
||||
@table @code
|
||||
@item nnultimate-directory
|
||||
@vindex nnultimate-directory
|
||||
The directory where @code{nnultimate} stores its files. The default is@*
|
||||
@file{~/News/ultimate/}.
|
||||
@end table
|
||||
|
||||
|
||||
@node Web Archive
|
||||
@subsection Web Archive
|
||||
@cindex nnwarchive
|
||||
@ -18552,7 +18511,6 @@ newsgroups.
|
||||
* Directory Groups:: You can read a directory as if it was a newsgroup.
|
||||
* Anything Groups:: Dired? Who needs dired?
|
||||
* Document Groups:: Single files can be the basis of a group.
|
||||
* SOUP:: Reading @sc{soup} packets ``offline''.
|
||||
* Mail-To-News Gateways:: Posting articles via mail-to-news gateways.
|
||||
@end menu
|
||||
|
||||
@ -18920,289 +18878,6 @@ correct type. A high number means high probability; a low number
|
||||
means low probability with @samp{0} being the lowest valid number.
|
||||
|
||||
|
||||
@node SOUP
|
||||
@subsection SOUP
|
||||
@cindex SOUP
|
||||
@cindex offline
|
||||
|
||||
In the PC world people often talk about ``offline'' newsreaders. These
|
||||
are thingies that are combined reader/news transport monstrosities.
|
||||
With built-in modem programs. Yecchh!
|
||||
|
||||
Of course, us Unix Weenie types of human beans use things like
|
||||
@code{uucp} and, like, @code{nntpd} and set up proper news and mail
|
||||
transport things like Ghod intended. And then we just use normal
|
||||
newsreaders.
|
||||
|
||||
However, it can sometimes be convenient to do something that's a bit
|
||||
easier on the brain if you have a very slow modem, and you're not really
|
||||
that interested in doing things properly.
|
||||
|
||||
A file format called @sc{soup} has been developed for transporting news
|
||||
and mail from servers to home machines and back again. It can be a bit
|
||||
fiddly.
|
||||
|
||||
First some terminology:
|
||||
|
||||
@table @dfn
|
||||
|
||||
@item server
|
||||
This is the machine that is connected to the outside world and where you
|
||||
get news and/or mail from.
|
||||
|
||||
@item home machine
|
||||
This is the machine that you want to do the actual reading and responding
|
||||
on. It is typically not connected to the rest of the world in any way.
|
||||
|
||||
@item packet
|
||||
Something that contains messages and/or commands. There are two kinds
|
||||
of packets:
|
||||
|
||||
@table @dfn
|
||||
@item message packets
|
||||
These are packets made at the server, and typically contain lots of
|
||||
messages for you to read. These are called @file{SoupoutX.tgz} by
|
||||
default, where @var{x} is a number.
|
||||
|
||||
@item response packets
|
||||
These are packets made at the home machine, and typically contains
|
||||
replies that you've written. These are called @file{SoupinX.tgz} by
|
||||
default, where @var{x} is a number.
|
||||
|
||||
@end table
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
@enumerate
|
||||
|
||||
@item
|
||||
You log in on the server and create a @sc{soup} packet. You can either
|
||||
use a dedicated @sc{soup} thingie (like the @code{awk} program), or you
|
||||
can use Gnus to create the packet with its @sc{soup} commands (@kbd{O
|
||||
s} and/or @kbd{G s b}; and then @kbd{G s p}) (@pxref{SOUP Commands}).
|
||||
|
||||
@item
|
||||
You transfer the packet home. Rail, boat, car or modem will do fine.
|
||||
|
||||
@item
|
||||
You put the packet in your home directory.
|
||||
|
||||
@item
|
||||
You fire up Gnus on your home machine using the @code{nnsoup} back end as
|
||||
the native or secondary server.
|
||||
|
||||
@item
|
||||
You read articles and mail and answer and followup to the things you
|
||||
want (@pxref{SOUP Replies}).
|
||||
|
||||
@item
|
||||
You do the @kbd{G s r} command to pack these replies into a @sc{soup}
|
||||
packet.
|
||||
|
||||
@item
|
||||
You transfer this packet to the server.
|
||||
|
||||
@item
|
||||
You use Gnus to mail this packet out with the @kbd{G s s} command.
|
||||
|
||||
@item
|
||||
You then repeat until you die.
|
||||
|
||||
@end enumerate
|
||||
|
||||
So you basically have a bipartite system---you use @code{nnsoup} for
|
||||
reading and Gnus for packing/sending these @sc{soup} packets.
|
||||
|
||||
@menu
|
||||
* SOUP Commands:: Commands for creating and sending @sc{soup} packets
|
||||
* SOUP Groups:: A back end for reading @sc{soup} packets.
|
||||
* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news.
|
||||
@end menu
|
||||
|
||||
|
||||
@node SOUP Commands
|
||||
@subsubsection SOUP Commands
|
||||
|
||||
These are commands for creating and manipulating @sc{soup} packets.
|
||||
|
||||
@table @kbd
|
||||
@item G s b
|
||||
@kindex G s b (Group)
|
||||
@findex gnus-group-brew-soup
|
||||
Pack all unread articles in the current group
|
||||
(@code{gnus-group-brew-soup}). This command understands the
|
||||
process/prefix convention.
|
||||
|
||||
@item G s w
|
||||
@kindex G s w (Group)
|
||||
@findex gnus-soup-save-areas
|
||||
Save all @sc{soup} data files (@code{gnus-soup-save-areas}).
|
||||
|
||||
@item G s s
|
||||
@kindex G s s (Group)
|
||||
@findex gnus-soup-send-replies
|
||||
Send all replies from the replies packet
|
||||
(@code{gnus-soup-send-replies}).
|
||||
|
||||
@item G s p
|
||||
@kindex G s p (Group)
|
||||
@findex gnus-soup-pack-packet
|
||||
Pack all files into a @sc{soup} packet (@code{gnus-soup-pack-packet}).
|
||||
|
||||
@item G s r
|
||||
@kindex G s r (Group)
|
||||
@findex nnsoup-pack-replies
|
||||
Pack all replies into a replies packet (@code{nnsoup-pack-replies}).
|
||||
|
||||
@item O s
|
||||
@kindex O s (Summary)
|
||||
@findex gnus-soup-add-article
|
||||
This summary-mode command adds the current article to a @sc{soup} packet
|
||||
(@code{gnus-soup-add-article}). It understands the process/prefix
|
||||
convention (@pxref{Process/Prefix}).
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
There are a few variables to customize where Gnus will put all these
|
||||
thingies:
|
||||
|
||||
@table @code
|
||||
|
||||
@item gnus-soup-directory
|
||||
@vindex gnus-soup-directory
|
||||
Directory where Gnus will save intermediate files while composing
|
||||
@sc{soup} packets. The default is @file{~/SoupBrew/}.
|
||||
|
||||
@item gnus-soup-replies-directory
|
||||
@vindex gnus-soup-replies-directory
|
||||
This is what Gnus will use as a temporary directory while sending our
|
||||
reply packets. @file{~/SoupBrew/SoupReplies/} is the default.
|
||||
|
||||
@item gnus-soup-prefix-file
|
||||
@vindex gnus-soup-prefix-file
|
||||
Name of the file where Gnus stores the last used prefix. The default is
|
||||
@samp{gnus-prefix}.
|
||||
|
||||
@item gnus-soup-packer
|
||||
@vindex gnus-soup-packer
|
||||
A format string command for packing a @sc{soup} packet. The default is
|
||||
@samp{tar cf - %s | gzip > $HOME/Soupout%d.tgz}.
|
||||
|
||||
@item gnus-soup-unpacker
|
||||
@vindex gnus-soup-unpacker
|
||||
Format string command for unpacking a @sc{soup} packet. The default is
|
||||
@samp{gunzip -c %s | tar xvf -}.
|
||||
|
||||
@item gnus-soup-packet-directory
|
||||
@vindex gnus-soup-packet-directory
|
||||
Where Gnus will look for reply packets. The default is @file{~/}.
|
||||
|
||||
@item gnus-soup-packet-regexp
|
||||
@vindex gnus-soup-packet-regexp
|
||||
Regular expression matching @sc{soup} reply packets in
|
||||
@code{gnus-soup-packet-directory}.
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
@node SOUP Groups
|
||||
@subsubsection SOUP Groups
|
||||
@cindex nnsoup
|
||||
|
||||
@code{nnsoup} is the back end for reading @sc{soup} packets. It will
|
||||
read incoming packets, unpack them, and put them in a directory where
|
||||
you can read them at leisure.
|
||||
|
||||
These are the variables you can use to customize its behavior:
|
||||
|
||||
@table @code
|
||||
|
||||
@item nnsoup-tmp-directory
|
||||
@vindex nnsoup-tmp-directory
|
||||
When @code{nnsoup} unpacks a @sc{soup} packet, it does it in this
|
||||
directory. (@file{/tmp/} by default.)
|
||||
|
||||
@item nnsoup-directory
|
||||
@vindex nnsoup-directory
|
||||
@code{nnsoup} then moves each message and index file to this directory.
|
||||
The default is @file{~/SOUP/}.
|
||||
|
||||
@item nnsoup-replies-directory
|
||||
@vindex nnsoup-replies-directory
|
||||
All replies will be stored in this directory before being packed into a
|
||||
reply packet. The default is @file{~/SOUP/replies/}.
|
||||
|
||||
@item nnsoup-replies-format-type
|
||||
@vindex nnsoup-replies-format-type
|
||||
The @sc{soup} format of the replies packets. The default is @samp{?n}
|
||||
(rnews), and I don't think you should touch that variable. I probably
|
||||
shouldn't even have documented it. Drats! Too late!
|
||||
|
||||
@item nnsoup-replies-index-type
|
||||
@vindex nnsoup-replies-index-type
|
||||
The index type of the replies packet. The default is @samp{?n}, which
|
||||
means ``none''. Don't fiddle with this one either!
|
||||
|
||||
@item nnsoup-active-file
|
||||
@vindex nnsoup-active-file
|
||||
Where @code{nnsoup} stores lots of information. This is not an ``active
|
||||
file'' in the @code{nntp} sense; it's an Emacs Lisp file. If you lose
|
||||
this file or mess it up in any way, you're dead. The default is
|
||||
@file{~/SOUP/active}.
|
||||
|
||||
@item nnsoup-packer
|
||||
@vindex nnsoup-packer
|
||||
Format string command for packing a reply @sc{soup} packet. The default
|
||||
is @samp{tar cf - %s | gzip > $HOME/Soupin%d.tgz}.
|
||||
|
||||
@item nnsoup-unpacker
|
||||
@vindex nnsoup-unpacker
|
||||
Format string command for unpacking incoming @sc{soup} packets. The
|
||||
default is @samp{gunzip -c %s | tar xvf -}.
|
||||
|
||||
@item nnsoup-packet-directory
|
||||
@vindex nnsoup-packet-directory
|
||||
Where @code{nnsoup} will look for incoming packets. The default is
|
||||
@file{~/}.
|
||||
|
||||
@item nnsoup-packet-regexp
|
||||
@vindex nnsoup-packet-regexp
|
||||
Regular expression matching incoming @sc{soup} packets. The default is
|
||||
@samp{Soupout}.
|
||||
|
||||
@item nnsoup-always-save
|
||||
@vindex nnsoup-always-save
|
||||
If non-@code{nil}, save the replies buffer after each posted message.
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
@node SOUP Replies
|
||||
@subsubsection SOUP Replies
|
||||
|
||||
Just using @code{nnsoup} won't mean that your postings and mailings end
|
||||
up in @sc{soup} reply packets automagically. You have to work a bit
|
||||
more for that to happen.
|
||||
|
||||
@findex nnsoup-set-variables
|
||||
The @code{nnsoup-set-variables} command will set the appropriate
|
||||
variables to ensure that all your followups and replies end up in the
|
||||
@sc{soup} system.
|
||||
|
||||
In specific, this is what it does:
|
||||
|
||||
@lisp
|
||||
(setq message-send-news-function 'nnsoup-request-post)
|
||||
(setq message-send-mail-function 'nnsoup-request-mail)
|
||||
@end lisp
|
||||
|
||||
And that's it, really. If you only want news to go into the @sc{soup}
|
||||
system you just use the first line. If you only want mail to be
|
||||
@sc{soup}ed you use the second.
|
||||
|
||||
|
||||
@node Mail-To-News Gateways
|
||||
@subsection Mail-To-News Gateways
|
||||
@cindex mail-to-news gateways
|
||||
@ -27927,8 +27602,7 @@ news batches, ClariNet briefs collections, and just about everything
|
||||
else (@pxref{Document Groups}).
|
||||
|
||||
@item
|
||||
Gnus has a new back end (@code{nnsoup}) to create/read SOUP packets
|
||||
(@pxref{SOUP}).
|
||||
Gnus has a new back end (@code{nnsoup}) to create/read SOUP packets.
|
||||
|
||||
@item
|
||||
The Gnus cache is much faster.
|
||||
@ -29492,7 +29166,7 @@ As the variables for the other back ends, there are
|
||||
@code{nnml-nov-is-evil}, @code{nnspool-nov-is-evil}, and
|
||||
@code{nnwarchive-nov-is-evil}. Note that a non-@code{nil} value for
|
||||
@code{gnus-nov-is-evil} overrides all those variables.@footnote{Although
|
||||
the back ends @code{nnkiboze}, @code{nnultimate}, and
|
||||
+the back ends @code{nnkiboze}, and
|
||||
@code{nnwfm} don't have their own nn*-nov-is-evil.}
|
||||
@end table
|
||||
|
||||
|
||||
@ -1,5 +1,11 @@
|
||||
2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* gnus-soup.el: Removed.
|
||||
|
||||
* nnsoup.el: Removed.
|
||||
|
||||
* nnultimate.el: Removed.
|
||||
|
||||
* gnus-html.el (gnus-blocked-images): New variable.
|
||||
|
||||
* message.el (message-prune-recipients): New function.
|
||||
|
||||
@ -680,13 +680,6 @@ simple manner.")
|
||||
"\177" gnus-group-delete-group
|
||||
[delete] gnus-group-delete-group)
|
||||
|
||||
(gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
|
||||
"b" gnus-group-brew-soup
|
||||
"w" gnus-soup-save-areas
|
||||
"s" gnus-soup-send-replies
|
||||
"p" gnus-soup-pack-packet
|
||||
"r" nnsoup-pack-replies)
|
||||
|
||||
(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
|
||||
"s" gnus-group-sort-groups
|
||||
"a" gnus-group-sort-groups-by-alphabet
|
||||
@ -972,13 +965,6 @@ simple manner.")
|
||||
(easy-menu-define
|
||||
gnus-group-misc-menu gnus-group-mode-map ""
|
||||
`("Gnus"
|
||||
("SOUP"
|
||||
["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
|
||||
["Send replies" gnus-soup-send-replies
|
||||
(fboundp 'gnus-soup-pack-packet)]
|
||||
["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
|
||||
["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
|
||||
["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
|
||||
["Send a mail" gnus-group-mail t]
|
||||
["Send a message (mail or news)" gnus-group-post-news t]
|
||||
["Create a local message" gnus-group-news t]
|
||||
|
||||
@ -1,611 +0,0 @@
|
||||
;;; gnus-soup.el --- SOUP packet writing support for Gnus
|
||||
|
||||
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
|
||||
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
|
||||
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
;; Keywords: news, mail
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(require 'gnus)
|
||||
(require 'gnus-art)
|
||||
(require 'message)
|
||||
(require 'gnus-start)
|
||||
(require 'gnus-range)
|
||||
|
||||
(defgroup gnus-soup nil
|
||||
"SOUP packet writing support for Gnus."
|
||||
:group 'gnus)
|
||||
|
||||
;;; User Variables:
|
||||
|
||||
(defcustom gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/")
|
||||
"Directory containing an unpacked SOUP packet."
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:type 'directory
|
||||
:group 'gnus-soup)
|
||||
|
||||
(defcustom gnus-soup-replies-directory
|
||||
(nnheader-concat gnus-soup-directory "SoupReplies/")
|
||||
"Directory where Gnus will do processing of replies."
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:type 'directory
|
||||
:group 'gnus-soup)
|
||||
|
||||
(defcustom gnus-soup-prefix-file "gnus-prefix"
|
||||
"Name of the file where Gnus stores the last used prefix."
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:type 'file
|
||||
:group 'gnus-soup)
|
||||
|
||||
(defcustom gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz"
|
||||
"Format string command for packing a SOUP packet.
|
||||
The SOUP files will be inserted where the %s is in the string.
|
||||
This string MUST contain both %s and %d. The file number will be
|
||||
inserted where %d appears."
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:type 'string
|
||||
:group 'gnus-soup)
|
||||
|
||||
(defcustom gnus-soup-unpacker "gunzip -c %s | tar xvf -"
|
||||
"Format string command for unpacking a SOUP packet.
|
||||
The SOUP packet file name will be inserted at the %s."
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:type 'string
|
||||
:group 'gnus-soup)
|
||||
|
||||
(defcustom gnus-soup-packet-directory gnus-home-directory
|
||||
"Where gnus-soup will look for REPLIES packets."
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:type 'directory
|
||||
:group 'gnus-soup)
|
||||
|
||||
(defcustom gnus-soup-packet-regexp "Soupin"
|
||||
"Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'."
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:type 'regexp
|
||||
:group 'gnus-soup)
|
||||
|
||||
(defcustom gnus-soup-ignored-headers "^Xref:"
|
||||
"Regexp to match headers to be removed when brewing SOUP packets."
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:type 'regexp
|
||||
:group 'gnus-soup)
|
||||
|
||||
;;; Internal Variables:
|
||||
|
||||
(defvar gnus-soup-encoding-type ?u
|
||||
"*Soup encoding type.
|
||||
`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox
|
||||
format.")
|
||||
|
||||
(defvar gnus-soup-index-type ?c
|
||||
"*Soup index type.
|
||||
`n' means no index file and `c' means standard Cnews overview
|
||||
format.")
|
||||
|
||||
(defvar gnus-soup-areas nil)
|
||||
(defvar gnus-soup-last-prefix nil)
|
||||
(defvar gnus-soup-prev-prefix nil)
|
||||
(defvar gnus-soup-buffers nil)
|
||||
|
||||
;;; Access macros:
|
||||
|
||||
(defmacro gnus-soup-area-prefix (area)
|
||||
`(aref ,area 0))
|
||||
(defmacro gnus-soup-set-area-prefix (area prefix)
|
||||
`(aset ,area 0 ,prefix))
|
||||
(defmacro gnus-soup-area-name (area)
|
||||
`(aref ,area 1))
|
||||
(defmacro gnus-soup-area-encoding (area)
|
||||
`(aref ,area 2))
|
||||
(defmacro gnus-soup-area-description (area)
|
||||
`(aref ,area 3))
|
||||
(defmacro gnus-soup-area-number (area)
|
||||
`(aref ,area 4))
|
||||
(defmacro gnus-soup-area-set-number (area value)
|
||||
`(aset ,area 4 ,value))
|
||||
|
||||
(defmacro gnus-soup-encoding-format (encoding)
|
||||
`(aref ,encoding 0))
|
||||
(defmacro gnus-soup-encoding-index (encoding)
|
||||
`(aref ,encoding 1))
|
||||
(defmacro gnus-soup-encoding-kind (encoding)
|
||||
`(aref ,encoding 2))
|
||||
|
||||
(defmacro gnus-soup-reply-prefix (reply)
|
||||
`(aref ,reply 0))
|
||||
(defmacro gnus-soup-reply-kind (reply)
|
||||
`(aref ,reply 1))
|
||||
(defmacro gnus-soup-reply-encoding (reply)
|
||||
`(aref ,reply 2))
|
||||
|
||||
;;; Commands:
|
||||
|
||||
(defun gnus-soup-send-replies ()
|
||||
"Unpack and send all replies in the reply packet."
|
||||
(interactive)
|
||||
(let ((packets (directory-files
|
||||
gnus-soup-packet-directory t gnus-soup-packet-regexp)))
|
||||
(while packets
|
||||
(when (gnus-soup-send-packet (car packets))
|
||||
(delete-file (car packets)))
|
||||
(setq packets (cdr packets)))))
|
||||
|
||||
(defun gnus-soup-add-article (n)
|
||||
"Add the current article to SOUP packet.
|
||||
If N is a positive number, add the N next articles.
|
||||
If N is a negative number, add the N previous articles.
|
||||
If N is nil and any articles have been marked with the process mark,
|
||||
move those articles instead."
|
||||
(interactive "P")
|
||||
(let* ((articles (gnus-summary-work-articles n))
|
||||
(tmp-buf (gnus-get-buffer-create "*soup work*"))
|
||||
(area (gnus-soup-area gnus-newsgroup-name))
|
||||
(prefix (gnus-soup-area-prefix area))
|
||||
headers)
|
||||
(buffer-disable-undo tmp-buf)
|
||||
(save-excursion
|
||||
(while articles
|
||||
;; Put the article in a buffer.
|
||||
(set-buffer tmp-buf)
|
||||
(when (gnus-request-article-this-buffer
|
||||
(car articles) gnus-newsgroup-name)
|
||||
(setq headers (nnheader-parse-head t))
|
||||
(save-restriction
|
||||
(message-narrow-to-head)
|
||||
(message-remove-header gnus-soup-ignored-headers t))
|
||||
(gnus-soup-store gnus-soup-directory prefix headers
|
||||
gnus-soup-encoding-type
|
||||
gnus-soup-index-type)
|
||||
(gnus-soup-area-set-number
|
||||
area (1+ (or (gnus-soup-area-number area) 0)))
|
||||
;; Mark article as read.
|
||||
(set-buffer gnus-summary-buffer)
|
||||
(gnus-summary-mark-as-read (car articles) gnus-souped-mark))
|
||||
(gnus-summary-remove-process-mark (car articles))
|
||||
(setq articles (cdr articles)))
|
||||
(kill-buffer tmp-buf))
|
||||
(gnus-soup-save-areas)
|
||||
(gnus-set-mode-line 'summary)))
|
||||
|
||||
(defun gnus-soup-pack-packet ()
|
||||
"Make a SOUP packet from the SOUP areas."
|
||||
(interactive)
|
||||
(gnus-soup-read-areas)
|
||||
(if (file-exists-p gnus-soup-directory)
|
||||
(if (directory-files gnus-soup-directory nil "\\.MSG$")
|
||||
(gnus-soup-pack gnus-soup-directory gnus-soup-packer)
|
||||
(message "No files to pack."))
|
||||
(message "No such directory: %s" gnus-soup-directory)))
|
||||
|
||||
(defun gnus-group-brew-soup (n)
|
||||
"Make a soup packet from the current group.
|
||||
Uses the process/prefix convention."
|
||||
(interactive "P")
|
||||
(let ((groups (gnus-group-process-prefix n)))
|
||||
(while groups
|
||||
(gnus-group-remove-mark (car groups))
|
||||
(gnus-soup-group-brew (car groups) t)
|
||||
(setq groups (cdr groups)))
|
||||
(gnus-soup-save-areas)))
|
||||
|
||||
(defun gnus-brew-soup (&optional level)
|
||||
"Go through all groups on LEVEL or less and make a soup packet."
|
||||
(interactive "P")
|
||||
(let ((level (or level gnus-level-subscribed))
|
||||
(newsrc (cdr gnus-newsrc-alist)))
|
||||
(while newsrc
|
||||
(when (<= (nth 1 (car newsrc)) level)
|
||||
(gnus-soup-group-brew (caar newsrc) t))
|
||||
(setq newsrc (cdr newsrc)))
|
||||
(gnus-soup-save-areas)))
|
||||
|
||||
;;;###autoload
|
||||
(defun gnus-batch-brew-soup ()
|
||||
"Brew a SOUP packet from groups mention on the command line.
|
||||
Will use the remaining command line arguments as regular expressions
|
||||
for matching on group names.
|
||||
|
||||
For instance, if you want to brew on all the nnml groups, as well as
|
||||
groups with \"emacs\" in the name, you could say something like:
|
||||
|
||||
$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"
|
||||
|
||||
Note -- this function hasn't been implemented yet."
|
||||
(interactive)
|
||||
nil)
|
||||
|
||||
;;; Internal Functions:
|
||||
|
||||
;; Store the current buffer.
|
||||
(defun gnus-soup-store (directory prefix headers format index)
|
||||
;; Create the directory, if needed.
|
||||
(gnus-make-directory directory)
|
||||
(let* ((msg-buf (nnheader-find-file-noselect
|
||||
(concat directory prefix ".MSG")))
|
||||
(idx-buf (if (= index ?n)
|
||||
nil
|
||||
(nnheader-find-file-noselect
|
||||
(concat directory prefix ".IDX"))))
|
||||
(article-buf (current-buffer))
|
||||
from head-line beg type)
|
||||
(setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
|
||||
(buffer-disable-undo msg-buf)
|
||||
(when idx-buf
|
||||
(push idx-buf gnus-soup-buffers)
|
||||
(buffer-disable-undo idx-buf))
|
||||
(save-excursion
|
||||
;; Make sure the last char in the buffer is a newline.
|
||||
(goto-char (point-max))
|
||||
(unless (= (current-column) 0)
|
||||
(insert "\n"))
|
||||
;; Find the "from".
|
||||
(goto-char (point-min))
|
||||
(setq from
|
||||
(gnus-mail-strip-quoted-names
|
||||
(or (mail-fetch-field "from")
|
||||
(mail-fetch-field "really-from")
|
||||
(mail-fetch-field "sender"))))
|
||||
(goto-char (point-min))
|
||||
;; Depending on what encoding is supposed to be used, we make
|
||||
;; a soup header.
|
||||
(setq head-line
|
||||
(cond
|
||||
((or (= gnus-soup-encoding-type ?u)
|
||||
(= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility.
|
||||
(format "#! rnews %d\n" (buffer-size)))
|
||||
((= gnus-soup-encoding-type ?m)
|
||||
(while (search-forward "\nFrom " nil t)
|
||||
(replace-match "\n>From " t t))
|
||||
(concat "From " (or from "unknown")
|
||||
" " (current-time-string) "\n"))
|
||||
((= gnus-soup-encoding-type ?M)
|
||||
"\^a\^a\^a\^a\n")
|
||||
(t (error "Unsupported type: %c" gnus-soup-encoding-type))))
|
||||
;; Insert the soup header and the article in the MSG buf.
|
||||
(set-buffer msg-buf)
|
||||
(goto-char (point-max))
|
||||
(insert head-line)
|
||||
(setq beg (point))
|
||||
(insert-buffer-substring article-buf)
|
||||
;; Insert the index in the IDX buf.
|
||||
(cond ((= index ?c)
|
||||
(set-buffer idx-buf)
|
||||
(gnus-soup-insert-idx beg headers))
|
||||
((/= index ?n)
|
||||
(error "Unknown index type: %c" type)))
|
||||
;; Return the MSG buf.
|
||||
msg-buf)))
|
||||
|
||||
(defun gnus-soup-group-brew (group &optional not-all)
|
||||
"Enter GROUP and add all articles to a SOUP package.
|
||||
If NOT-ALL, don't pack ticked articles."
|
||||
(let ((gnus-expert-user t)
|
||||
(gnus-large-newsgroup nil)
|
||||
(entry (gnus-group-entry group)))
|
||||
(when (or (null entry)
|
||||
(eq (car entry) t)
|
||||
(and (car entry)
|
||||
(> (car entry) 0))
|
||||
(and (not not-all)
|
||||
(gnus-range-length (cdr (assq 'tick (gnus-info-marks
|
||||
(nth 2 entry)))))))
|
||||
(when (gnus-summary-read-group group nil t)
|
||||
(setq gnus-newsgroup-processable
|
||||
(reverse
|
||||
(if (not not-all)
|
||||
(append gnus-newsgroup-marked gnus-newsgroup-unreads)
|
||||
gnus-newsgroup-unreads)))
|
||||
(gnus-soup-add-article nil)
|
||||
(gnus-summary-exit)))))
|
||||
|
||||
(defun gnus-soup-insert-idx (offset header)
|
||||
;; [number subject from date id references chars lines xref]
|
||||
(goto-char (point-max))
|
||||
(insert
|
||||
(format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n"
|
||||
offset
|
||||
(or (mail-header-subject header) "(none)")
|
||||
(or (mail-header-from header) "(nobody)")
|
||||
(or (mail-header-date header) "")
|
||||
(or (mail-header-id header)
|
||||
(concat "soup-dummy-id-"
|
||||
(mapconcat
|
||||
(lambda (time) (int-to-string time))
|
||||
(current-time) "-")))
|
||||
(or (mail-header-references header) "")
|
||||
(or (mail-header-chars header) 0)
|
||||
(or (mail-header-lines header) "0"))))
|
||||
|
||||
(defun gnus-soup-save-areas ()
|
||||
"Write all SOUP buffers."
|
||||
(interactive)
|
||||
(gnus-soup-write-areas)
|
||||
(save-excursion
|
||||
(let (buf)
|
||||
(while gnus-soup-buffers
|
||||
(setq buf (car gnus-soup-buffers)
|
||||
gnus-soup-buffers (cdr gnus-soup-buffers))
|
||||
(if (not (buffer-name buf))
|
||||
()
|
||||
(set-buffer buf)
|
||||
(when (buffer-modified-p)
|
||||
(save-buffer))
|
||||
(kill-buffer (current-buffer)))))
|
||||
(gnus-soup-write-prefixes)))
|
||||
|
||||
(defun gnus-soup-write-prefixes ()
|
||||
(let ((prefixes gnus-soup-last-prefix)
|
||||
prefix)
|
||||
(save-excursion
|
||||
(gnus-set-work-buffer)
|
||||
(while (setq prefix (pop prefixes))
|
||||
(erase-buffer)
|
||||
(insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))
|
||||
(let ((coding-system-for-write mm-text-coding-system))
|
||||
(gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))))
|
||||
|
||||
(defun gnus-soup-pack (dir packer)
|
||||
(let* ((files (mapconcat 'identity
|
||||
'("AREAS" "*.MSG" "*.IDX" "INFO"
|
||||
"LIST" "REPLIES" "COMMANDS" "ERRORS")
|
||||
" "))
|
||||
(packer (if (< (string-match "%s" packer)
|
||||
(string-match "%d" packer))
|
||||
(format packer files
|
||||
(string-to-number (gnus-soup-unique-prefix dir)))
|
||||
(format packer
|
||||
(string-to-number (gnus-soup-unique-prefix dir))
|
||||
files)))
|
||||
(dir (expand-file-name dir)))
|
||||
(gnus-make-directory dir)
|
||||
(setq gnus-soup-areas nil)
|
||||
(gnus-message 4 "Packing %s..." packer)
|
||||
(if (eq 0 (call-process shell-file-name
|
||||
nil nil nil shell-command-switch
|
||||
(concat "cd " dir " ; " packer)))
|
||||
(progn
|
||||
(call-process shell-file-name nil nil nil shell-command-switch
|
||||
(concat "cd " dir " ; rm " files))
|
||||
(gnus-message 4 "Packing...done" packer))
|
||||
(error "Couldn't pack packet"))))
|
||||
|
||||
(defun gnus-soup-parse-areas (file)
|
||||
"Parse soup area file FILE.
|
||||
The result is a of vectors, each containing one entry from the AREA file.
|
||||
The vector contain five strings,
|
||||
[prefix name encoding description number]
|
||||
though the two last may be nil if they are missing."
|
||||
(let (areas)
|
||||
(when (file-exists-p file)
|
||||
(save-excursion
|
||||
(set-buffer (nnheader-find-file-noselect file 'force))
|
||||
(buffer-disable-undo)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(push (vector (gnus-soup-field)
|
||||
(gnus-soup-field)
|
||||
(gnus-soup-field)
|
||||
(and (eq (preceding-char) ?\t)
|
||||
(gnus-soup-field))
|
||||
(and (eq (preceding-char) ?\t)
|
||||
(string-to-number (gnus-soup-field))))
|
||||
areas)
|
||||
(when (eq (preceding-char) ?\t)
|
||||
(beginning-of-line 2)))
|
||||
(kill-buffer (current-buffer))))
|
||||
areas))
|
||||
|
||||
(defun gnus-soup-parse-replies (file)
|
||||
"Parse soup REPLIES file FILE.
|
||||
The result is a of vectors, each containing one entry from the REPLIES
|
||||
file. The vector contain three strings, [prefix name encoding]."
|
||||
(let (replies)
|
||||
(save-excursion
|
||||
(set-buffer (nnheader-find-file-noselect file))
|
||||
(buffer-disable-undo)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(push (vector (gnus-soup-field) (gnus-soup-field)
|
||||
(gnus-soup-field))
|
||||
replies)
|
||||
(when (eq (preceding-char) ?\t)
|
||||
(beginning-of-line 2)))
|
||||
(kill-buffer (current-buffer)))
|
||||
replies))
|
||||
|
||||
(defun gnus-soup-field ()
|
||||
(prog1
|
||||
(buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point)))
|
||||
(forward-char 1)))
|
||||
|
||||
(defun gnus-soup-read-areas ()
|
||||
(or gnus-soup-areas
|
||||
(setq gnus-soup-areas
|
||||
(gnus-soup-parse-areas (concat gnus-soup-directory "AREAS")))))
|
||||
|
||||
(defun gnus-soup-write-areas ()
|
||||
"Write the AREAS file."
|
||||
(interactive)
|
||||
(when gnus-soup-areas
|
||||
(with-temp-file (concat gnus-soup-directory "AREAS")
|
||||
(let ((areas gnus-soup-areas)
|
||||
area)
|
||||
(while (setq area (pop areas))
|
||||
(insert
|
||||
(format
|
||||
"%s\t%s\t%s%s\n"
|
||||
(gnus-soup-area-prefix area)
|
||||
(gnus-soup-area-name area)
|
||||
(gnus-soup-area-encoding area)
|
||||
(if (or (gnus-soup-area-description area)
|
||||
(gnus-soup-area-number area))
|
||||
(concat "\t" (or (gnus-soup-area-description
|
||||
area) "")
|
||||
(if (gnus-soup-area-number area)
|
||||
(concat "\t" (int-to-string
|
||||
(gnus-soup-area-number area)))
|
||||
"")) ""))))))))
|
||||
|
||||
(defun gnus-soup-write-replies (dir areas)
|
||||
"Write a REPLIES file in DIR containing AREAS."
|
||||
(with-temp-file (concat dir "REPLIES")
|
||||
(let (area)
|
||||
(while (setq area (pop areas))
|
||||
(insert (format "%s\t%s\t%s\n"
|
||||
(gnus-soup-reply-prefix area)
|
||||
(gnus-soup-reply-kind area)
|
||||
(gnus-soup-reply-encoding area)))))))
|
||||
|
||||
(defun gnus-soup-area (group)
|
||||
(gnus-soup-read-areas)
|
||||
(let ((areas gnus-soup-areas)
|
||||
(real-group (gnus-group-real-name group))
|
||||
area result)
|
||||
(while areas
|
||||
(setq area (car areas)
|
||||
areas (cdr areas))
|
||||
(when (equal (gnus-soup-area-name area) real-group)
|
||||
(setq result area)))
|
||||
(unless result
|
||||
(setq result
|
||||
(vector (gnus-soup-unique-prefix)
|
||||
real-group
|
||||
(format "%c%c%c"
|
||||
gnus-soup-encoding-type
|
||||
gnus-soup-index-type
|
||||
(if (gnus-member-of-valid 'mail group) ?m ?n))
|
||||
nil nil)
|
||||
gnus-soup-areas (cons result gnus-soup-areas)))
|
||||
result))
|
||||
|
||||
(defun gnus-soup-unique-prefix (&optional dir)
|
||||
(let* ((dir (file-name-as-directory (or dir gnus-soup-directory)))
|
||||
(entry (assoc dir gnus-soup-last-prefix))
|
||||
gnus-soup-prev-prefix)
|
||||
(if entry
|
||||
()
|
||||
(when (file-exists-p (concat dir gnus-soup-prefix-file))
|
||||
(ignore-errors
|
||||
(load (concat dir gnus-soup-prefix-file) nil t t)))
|
||||
(push (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
|
||||
gnus-soup-last-prefix))
|
||||
(setcdr entry (1+ (cdr entry)))
|
||||
(gnus-soup-write-prefixes)
|
||||
(int-to-string (cdr entry))))
|
||||
|
||||
(defun gnus-soup-unpack-packet (dir unpacker packet)
|
||||
"Unpack PACKET into DIR using UNPACKER.
|
||||
Return whether the unpacking was successful."
|
||||
(gnus-make-directory dir)
|
||||
(gnus-message 4 "Unpacking: %s" (format unpacker packet))
|
||||
(prog1
|
||||
(eq 0 (call-process
|
||||
shell-file-name nil nil nil shell-command-switch
|
||||
(format "cd %s ; %s" (expand-file-name dir)
|
||||
(format unpacker packet))))
|
||||
(gnus-message 4 "Unpacking...done")))
|
||||
|
||||
(defun gnus-soup-send-packet (packet)
|
||||
(gnus-soup-unpack-packet
|
||||
gnus-soup-replies-directory gnus-soup-unpacker packet)
|
||||
(let ((replies (gnus-soup-parse-replies
|
||||
(concat gnus-soup-replies-directory "REPLIES"))))
|
||||
(save-excursion
|
||||
(while replies
|
||||
(let* ((msg-file (concat gnus-soup-replies-directory
|
||||
(gnus-soup-reply-prefix (car replies))
|
||||
".MSG"))
|
||||
(msg-buf (and (file-exists-p msg-file)
|
||||
(nnheader-find-file-noselect msg-file)))
|
||||
(tmp-buf (gnus-get-buffer-create " *soup send*"))
|
||||
beg end)
|
||||
(cond
|
||||
((and (/= (gnus-soup-encoding-format
|
||||
(gnus-soup-reply-encoding (car replies)))
|
||||
?u)
|
||||
(/= (gnus-soup-encoding-format
|
||||
(gnus-soup-reply-encoding (car replies)))
|
||||
?n)) ;; Gnus back compatibility.
|
||||
(error "Unsupported encoding"))
|
||||
((null msg-buf)
|
||||
t)
|
||||
(t
|
||||
(buffer-disable-undo msg-buf)
|
||||
(set-buffer msg-buf)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(unless (looking-at "#! *rnews +\\([0-9]+\\)")
|
||||
(error "Bad header"))
|
||||
(forward-line 1)
|
||||
(setq beg (point)
|
||||
end (+ (point) (string-to-number
|
||||
(buffer-substring
|
||||
(match-beginning 1) (match-end 1)))))
|
||||
(switch-to-buffer tmp-buf)
|
||||
(erase-buffer)
|
||||
(mm-disable-multibyte)
|
||||
(insert-buffer-substring msg-buf beg end)
|
||||
(cond
|
||||
((string= (gnus-soup-reply-kind (car replies)) "news")
|
||||
(gnus-message 5 "Sending news message to %s..."
|
||||
(mail-fetch-field "newsgroups"))
|
||||
(sit-for 1)
|
||||
(let ((message-syntax-checks
|
||||
'dont-check-for-anything-just-trust-me)
|
||||
(method (if (functionp message-post-method)
|
||||
(funcall message-post-method)
|
||||
message-post-method))
|
||||
result)
|
||||
(run-hooks 'message-send-news-hook)
|
||||
(gnus-open-server method)
|
||||
(message "Sending news via %s..."
|
||||
(gnus-server-string method))
|
||||
(unless (let ((mail-header-separator ""))
|
||||
(gnus-request-post method))
|
||||
(message "Couldn't send message via news: %s"
|
||||
(nnheader-get-report (car method))))))
|
||||
((string= (gnus-soup-reply-kind (car replies)) "mail")
|
||||
(gnus-message 5 "Sending mail to %s..."
|
||||
(mail-fetch-field "to"))
|
||||
(sit-for 1)
|
||||
(let ((mail-header-separator ""))
|
||||
(funcall (or message-send-mail-real-function
|
||||
message-send-mail-function))))
|
||||
(t
|
||||
(error "Unknown reply kind")))
|
||||
(set-buffer msg-buf)
|
||||
(goto-char end))
|
||||
(delete-file (buffer-file-name))
|
||||
(kill-buffer msg-buf)
|
||||
(kill-buffer tmp-buf)
|
||||
(gnus-message 4 "Sent packet"))))
|
||||
(setq replies (cdr replies)))
|
||||
t)))
|
||||
|
||||
(provide 'gnus-soup)
|
||||
|
||||
;; arch-tag: eddfa69d-13e8-4aea-84ef-62a526ef185c
|
||||
;;; gnus-soup.el ends here
|
||||
@ -538,11 +538,6 @@ string with the suggested prefix."
|
||||
:group 'gnus-summary-marks
|
||||
:type 'character)
|
||||
|
||||
(defcustom gnus-souped-mark ?F
|
||||
"*Mark used for souped articles."
|
||||
:group 'gnus-summary-marks
|
||||
:type 'character)
|
||||
|
||||
(defcustom gnus-kill-file-mark ?X
|
||||
"*Mark used for articles killed by kill files."
|
||||
:group 'gnus-summary-marks
|
||||
@ -666,7 +661,7 @@ string with the suggested prefix."
|
||||
(defcustom gnus-auto-expirable-marks
|
||||
(list gnus-killed-mark gnus-del-mark gnus-catchup-mark
|
||||
gnus-low-score-mark gnus-ancient-mark gnus-read-mark
|
||||
gnus-souped-mark gnus-duplicate-mark)
|
||||
gnus-duplicate-mark)
|
||||
"*The list of marks converted into expiration if a group is auto-expirable."
|
||||
:version "21.1"
|
||||
:group 'gnus-summary
|
||||
@ -1258,7 +1253,7 @@ type of files to save."
|
||||
"Whether Gnus should parse all headers made available to it.
|
||||
This is mostly relevant for slow back ends where the user may
|
||||
wish to widen the summary buffer to include all headers
|
||||
that were fetched. Say, for nnultimate groups."
|
||||
that were fetched."
|
||||
:version "22.1"
|
||||
:group 'gnus-summary
|
||||
:type '(choice boolean regexp))
|
||||
@ -2180,8 +2175,7 @@ increase the score of each group you read."
|
||||
"h" gnus-summary-save-article-folder
|
||||
"v" gnus-summary-save-article-vm
|
||||
"p" gnus-summary-pipe-output
|
||||
"P" gnus-summary-muttprint
|
||||
"s" gnus-soup-add-article)
|
||||
"P" gnus-summary-muttprint)
|
||||
|
||||
(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
|
||||
"b" gnus-summary-display-buttonized
|
||||
@ -2445,7 +2439,6 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
|
||||
["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
|
||||
["Save body in file..." gnus-summary-save-article-body-file t]
|
||||
["Pipe through a filter..." gnus-summary-pipe-output t]
|
||||
["Add to SOUP packet" gnus-soup-add-article t]
|
||||
["Print with Muttprint..." gnus-summary-muttprint t]
|
||||
["Print" gnus-summary-print-article
|
||||
,@(if (featurep 'xemacs) '(t)
|
||||
@ -8305,7 +8298,7 @@ If ALL is non-nil, limit strictly to unread articles."
|
||||
gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
|
||||
gnus-low-score-mark gnus-expirable-mark
|
||||
gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
|
||||
gnus-duplicate-mark gnus-souped-mark)
|
||||
gnus-duplicate-mark)
|
||||
'reverse)))
|
||||
|
||||
(defun gnus-summary-limit-to-headers (match &optional reverse)
|
||||
|
||||
@ -1741,12 +1741,10 @@ slower."
|
||||
("nndoc" none address prompt-address)
|
||||
("nnbabyl" mail address respool)
|
||||
("nnkiboze" post virtual)
|
||||
("nnsoup" post-mail address)
|
||||
("nndraft" post-mail)
|
||||
("nnfolder" mail respool address)
|
||||
("nngateway" post-mail address prompt-address physical-address)
|
||||
("nnweb" none)
|
||||
("nnultimate" none)
|
||||
("nnrss" none)
|
||||
("nnwfm" none)
|
||||
("nnwarchive" none)
|
||||
@ -2892,10 +2890,6 @@ gnus-registry.el will populate this if it's loaded.")
|
||||
("rmailsum" rmail-update-summary)
|
||||
("gnus-audio" :interactive t gnus-audio-play)
|
||||
("gnus-xmas" gnus-xmas-splash)
|
||||
("gnus-soup" :interactive t
|
||||
gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
|
||||
gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
|
||||
("nnsoup" nnsoup-pack-replies)
|
||||
("score-mode" :interactive t gnus-score-mode)
|
||||
("gnus-mh" gnus-summary-save-article-folder
|
||||
gnus-Folder-save-name gnus-folder-save-name)
|
||||
|
||||
@ -1,812 +0,0 @@
|
||||
;;; nnsoup.el --- SOUP access for Gnus
|
||||
|
||||
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
|
||||
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
|
||||
;; Keywords: news, mail
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'nnheader)
|
||||
(require 'nnmail)
|
||||
(require 'gnus-soup)
|
||||
(require 'gnus-msg)
|
||||
(require 'nnoo)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(nnoo-declare nnsoup)
|
||||
|
||||
(defvoo nnsoup-directory (nnheader-concat gnus-home-directory "SOUP/")
|
||||
"*SOUP packet directory.")
|
||||
|
||||
(defvoo nnsoup-tmp-directory
|
||||
(cond ((fboundp 'temp-directory) (temp-directory))
|
||||
((boundp 'temporary-file-directory) temporary-file-directory)
|
||||
("/tmp/"))
|
||||
"*Where nnsoup will store temporary files.")
|
||||
|
||||
(defvoo nnsoup-replies-directory (expand-file-name "replies/" nnsoup-directory)
|
||||
"*Directory where outgoing packets will be composed.")
|
||||
|
||||
(defvoo nnsoup-replies-format-type ?u ;; u is USENET news format.
|
||||
"*Format of the replies packages.")
|
||||
|
||||
(defvoo nnsoup-replies-index-type ?n
|
||||
"*Index type of the replies packages.")
|
||||
|
||||
(defvoo nnsoup-active-file (expand-file-name "active" nnsoup-directory)
|
||||
"Active file.")
|
||||
|
||||
(defvoo nnsoup-packer (concat "tar cf - %s | gzip > "
|
||||
(expand-file-name gnus-home-directory)
|
||||
"Soupin%d.tgz")
|
||||
"Format string command for packing a SOUP packet.
|
||||
The SOUP files will be inserted where the %s is in the string.
|
||||
This string MUST contain both %s and %d. The file number will be
|
||||
inserted where %d appears.")
|
||||
|
||||
(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -"
|
||||
"*Format string command for unpacking a SOUP packet.
|
||||
The SOUP packet file name will be inserted at the %s.")
|
||||
|
||||
(defvoo nnsoup-packet-directory gnus-home-directory
|
||||
"*Where nnsoup will look for incoming packets.")
|
||||
|
||||
(defvoo nnsoup-packet-regexp "Soupout"
|
||||
"*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
|
||||
|
||||
(defvoo nnsoup-always-save t
|
||||
"If non-nil commit the reply buffer on each message send.
|
||||
This is necessary if using message mode outside Gnus with nnsoup as a
|
||||
backend for the messages.")
|
||||
|
||||
|
||||
|
||||
(defconst nnsoup-version "nnsoup 0.0"
|
||||
"nnsoup version.")
|
||||
|
||||
(defvoo nnsoup-status-string "")
|
||||
(defvoo nnsoup-group-alist nil)
|
||||
(defvoo nnsoup-current-prefix 0)
|
||||
(defvoo nnsoup-replies-list nil)
|
||||
(defvoo nnsoup-buffers nil)
|
||||
(defvoo nnsoup-current-group nil)
|
||||
(defvoo nnsoup-group-alist-touched nil)
|
||||
(defvoo nnsoup-article-alist nil)
|
||||
|
||||
|
||||
;;; Interface functions.
|
||||
|
||||
(nnoo-define-basics nnsoup)
|
||||
|
||||
(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old)
|
||||
(nnsoup-possibly-change-group group)
|
||||
(save-excursion
|
||||
(set-buffer nntp-server-buffer)
|
||||
(erase-buffer)
|
||||
(let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist)))
|
||||
(articles sequence)
|
||||
(use-nov t)
|
||||
useful-areas this-area-seq msg-buf)
|
||||
(if (stringp (car sequence))
|
||||
;; We don't support fetching by Message-ID.
|
||||
'headers
|
||||
;; We go through all the areas and find which files the
|
||||
;; articles in SEQUENCE come from.
|
||||
(while (and areas sequence)
|
||||
;; Peel off areas that are below sequence.
|
||||
(while (and areas (< (cdar (car areas)) (car sequence)))
|
||||
(setq areas (cdr areas)))
|
||||
(when areas
|
||||
;; This is a useful area.
|
||||
(push (car areas) useful-areas)
|
||||
(setq this-area-seq nil)
|
||||
;; We take note whether this MSG has a corresponding IDX
|
||||
;; for later use.
|
||||
(when (or (= (gnus-soup-encoding-index
|
||||
(gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
|
||||
(not (file-exists-p
|
||||
(nnsoup-file
|
||||
(gnus-soup-area-prefix (nth 1 (car areas)))))))
|
||||
(setq use-nov nil))
|
||||
;; We assign the portion of `sequence' that is relevant to
|
||||
;; this MSG packet to this packet.
|
||||
(while (and sequence (<= (car sequence) (cdar (car areas))))
|
||||
(push (car sequence) this-area-seq)
|
||||
(setq sequence (cdr sequence)))
|
||||
(setcar useful-areas (cons (nreverse this-area-seq)
|
||||
(car useful-areas)))))
|
||||
|
||||
;; We now have a list of article numbers and corresponding
|
||||
;; areas.
|
||||
(setq useful-areas (nreverse useful-areas))
|
||||
|
||||
;; Two different approaches depending on whether all the MSG
|
||||
;; files have corresponding IDX files. If they all do, we
|
||||
;; simply return the relevant IDX files and let Gnus sort out
|
||||
;; what lines are relevant. If some of the IDX files are
|
||||
;; missing, we must return HEADs for all the articles.
|
||||
(if use-nov
|
||||
;; We have IDX files for all areas.
|
||||
(progn
|
||||
(while useful-areas
|
||||
(goto-char (point-max))
|
||||
(let ((b (point))
|
||||
(number (car (nth 1 (car useful-areas))))
|
||||
(index-buffer (nnsoup-index-buffer
|
||||
(gnus-soup-area-prefix
|
||||
(nth 2 (car useful-areas))))))
|
||||
(when index-buffer
|
||||
(insert-buffer-substring index-buffer)
|
||||
(goto-char b)
|
||||
;; We have to remove the index number entries and
|
||||
;; insert article numbers instead.
|
||||
(while (looking-at "[0-9]+")
|
||||
(replace-match (int-to-string number) t t)
|
||||
(incf number)
|
||||
(forward-line 1))))
|
||||
(setq useful-areas (cdr useful-areas)))
|
||||
'nov)
|
||||
;; We insert HEADs.
|
||||
(while useful-areas
|
||||
(setq articles (caar useful-areas)
|
||||
useful-areas (cdr useful-areas))
|
||||
(while articles
|
||||
(when (setq msg-buf
|
||||
(nnsoup-narrow-to-article
|
||||
(car articles) (cdar useful-areas) 'head))
|
||||
(goto-char (point-max))
|
||||
(insert (format "221 %d Article retrieved.\n" (car articles)))
|
||||
(insert-buffer-substring msg-buf)
|
||||
(goto-char (point-max))
|
||||
(insert ".\n"))
|
||||
(setq articles (cdr articles))))
|
||||
|
||||
(nnheader-fold-continuation-lines)
|
||||
'headers)))))
|
||||
|
||||
(deffoo nnsoup-open-server (server &optional defs)
|
||||
(nnoo-change-server 'nnsoup server defs)
|
||||
(when (not (file-exists-p nnsoup-directory))
|
||||
(condition-case ()
|
||||
(make-directory nnsoup-directory t)
|
||||
(error t)))
|
||||
(cond
|
||||
((not (file-exists-p nnsoup-directory))
|
||||
(nnsoup-close-server)
|
||||
(nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
|
||||
((not (file-directory-p (file-truename nnsoup-directory)))
|
||||
(nnsoup-close-server)
|
||||
(nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory))
|
||||
(t
|
||||
(nnsoup-read-active-file)
|
||||
(nnheader-report 'nnsoup "Opened server %s using directory %s"
|
||||
server nnsoup-directory)
|
||||
t)))
|
||||
|
||||
(deffoo nnsoup-request-close ()
|
||||
(nnsoup-write-active-file)
|
||||
(nnsoup-write-replies)
|
||||
(gnus-soup-save-areas)
|
||||
;; Kill all nnsoup buffers.
|
||||
(let (buffer)
|
||||
(while nnsoup-buffers
|
||||
(setq buffer (cdr (pop nnsoup-buffers)))
|
||||
(and buffer
|
||||
(buffer-name buffer)
|
||||
(kill-buffer buffer))))
|
||||
(setq nnsoup-group-alist nil
|
||||
nnsoup-group-alist-touched nil
|
||||
nnsoup-current-group nil
|
||||
nnsoup-replies-list nil)
|
||||
(nnoo-close-server 'nnoo)
|
||||
t)
|
||||
|
||||
(deffoo nnsoup-request-article (id &optional newsgroup server buffer)
|
||||
(nnsoup-possibly-change-group newsgroup)
|
||||
(let (buf)
|
||||
(save-excursion
|
||||
(set-buffer (or buffer nntp-server-buffer))
|
||||
(erase-buffer)
|
||||
(when (and (not (stringp id))
|
||||
(setq buf (nnsoup-narrow-to-article id)))
|
||||
(insert-buffer-substring buf)
|
||||
t))))
|
||||
|
||||
(deffoo nnsoup-request-group (group &optional server dont-check)
|
||||
(nnsoup-possibly-change-group group)
|
||||
(if dont-check
|
||||
t
|
||||
(let ((active (cadr (assoc group nnsoup-group-alist))))
|
||||
(if (not active)
|
||||
(nnheader-report 'nnsoup "No such group: %s" group)
|
||||
(nnheader-insert
|
||||
"211 %d %d %d %s\n"
|
||||
(max (1+ (- (cdr active) (car active))) 0)
|
||||
(car active) (cdr active) group)))))
|
||||
|
||||
(deffoo nnsoup-request-type (group &optional article)
|
||||
(nnsoup-possibly-change-group group)
|
||||
;; Try to guess the type based on the first article in the group.
|
||||
(when (not article)
|
||||
(setq article
|
||||
(cdar (car (cddr (assoc group nnsoup-group-alist))))))
|
||||
(if (not article)
|
||||
'unknown
|
||||
(let ((kind (gnus-soup-encoding-kind
|
||||
(gnus-soup-area-encoding
|
||||
(nth 1 (nnsoup-article-to-area
|
||||
article nnsoup-current-group))))))
|
||||
(cond ((= kind ?m) 'mail)
|
||||
((= kind ?n) 'news)
|
||||
(t 'unknown)))))
|
||||
|
||||
(deffoo nnsoup-close-group (group &optional server)
|
||||
;; Kill all nnsoup buffers.
|
||||
(let ((buffers nnsoup-buffers)
|
||||
elem)
|
||||
(while buffers
|
||||
(when (equal (car (setq elem (pop buffers))) group)
|
||||
(setq nnsoup-buffers (delq elem nnsoup-buffers))
|
||||
(and (cdr elem) (buffer-name (cdr elem))
|
||||
(kill-buffer (cdr elem))))))
|
||||
t)
|
||||
|
||||
(deffoo nnsoup-request-list (&optional server)
|
||||
(save-excursion
|
||||
(set-buffer nntp-server-buffer)
|
||||
(erase-buffer)
|
||||
(unless nnsoup-group-alist
|
||||
(nnsoup-read-active-file))
|
||||
(let ((alist nnsoup-group-alist)
|
||||
(standard-output (current-buffer))
|
||||
entry)
|
||||
(while (setq entry (pop alist))
|
||||
(insert (car entry) " ")
|
||||
(princ (cdadr entry))
|
||||
(insert " ")
|
||||
(princ (caadr entry))
|
||||
(insert " y\n"))
|
||||
t)))
|
||||
|
||||
(deffoo nnsoup-request-scan (group &optional server)
|
||||
(nnsoup-unpack-packets))
|
||||
|
||||
(deffoo nnsoup-request-newgroups (date &optional server)
|
||||
(nnsoup-request-list))
|
||||
|
||||
(deffoo nnsoup-request-list-newsgroups (&optional server)
|
||||
nil)
|
||||
|
||||
(deffoo nnsoup-request-post (&optional server)
|
||||
(nnsoup-store-reply "news")
|
||||
t)
|
||||
|
||||
(deffoo nnsoup-request-mail (&optional server)
|
||||
(nnsoup-store-reply "mail")
|
||||
t)
|
||||
|
||||
(deffoo nnsoup-request-expire-articles (articles group &optional server force)
|
||||
(nnsoup-possibly-change-group group)
|
||||
(let* ((total-infolist (assoc group nnsoup-group-alist))
|
||||
(active (cadr total-infolist))
|
||||
(infolist (cddr total-infolist))
|
||||
info range-list mod-time prefix)
|
||||
(while infolist
|
||||
(setq info (pop infolist)
|
||||
range-list (gnus-uncompress-range (car info))
|
||||
prefix (gnus-soup-area-prefix (nth 1 info)))
|
||||
(when;; All the articles in this file are marked for expiry.
|
||||
(and (or (setq mod-time (nth 5 (file-attributes
|
||||
(nnsoup-file prefix))))
|
||||
(setq mod-time (nth 5 (file-attributes
|
||||
(nnsoup-file prefix t)))))
|
||||
(gnus-sublist-p articles range-list)
|
||||
;; This file is old enough.
|
||||
(nnmail-expired-article-p group mod-time force))
|
||||
;; Ok, we delete this file.
|
||||
(when (ignore-errors
|
||||
(nnheader-message
|
||||
5 "Deleting %s in group %s..." (nnsoup-file prefix)
|
||||
group)
|
||||
(when (file-exists-p (nnsoup-file prefix))
|
||||
(delete-file (nnsoup-file prefix)))
|
||||
(nnheader-message
|
||||
5 "Deleting %s in group %s..." (nnsoup-file prefix t)
|
||||
group)
|
||||
(when (file-exists-p (nnsoup-file prefix t))
|
||||
(delete-file (nnsoup-file prefix t)))
|
||||
t)
|
||||
(setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
|
||||
(setq articles (gnus-sorted-difference articles range-list))))
|
||||
(when (not mod-time)
|
||||
(setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
|
||||
(if (cddr total-infolist)
|
||||
(setcar active (caaadr (cdr total-infolist)))
|
||||
(setcar active (1+ (cdr active))))
|
||||
(nnsoup-write-active-file t)
|
||||
;; Return the articles that weren't expired.
|
||||
articles))
|
||||
|
||||
|
||||
;;; Internal functions
|
||||
|
||||
(defun nnsoup-possibly-change-group (group &optional force)
|
||||
(when (and group
|
||||
(not (equal nnsoup-current-group group)))
|
||||
(setq nnsoup-article-alist nil)
|
||||
(setq nnsoup-current-group group))
|
||||
t)
|
||||
|
||||
(defun nnsoup-read-active-file ()
|
||||
(setq nnsoup-group-alist nil)
|
||||
(when (file-exists-p nnsoup-active-file)
|
||||
(ignore-errors
|
||||
(load nnsoup-active-file t t t))
|
||||
;; Be backwards compatible.
|
||||
(when (and nnsoup-group-alist
|
||||
(not (atom (caadar nnsoup-group-alist))))
|
||||
(let ((alist nnsoup-group-alist)
|
||||
entry e min max)
|
||||
(while (setq e (cdr (setq entry (pop alist))))
|
||||
(setq min (caaar e))
|
||||
(setq max (cdar (car (last e))))
|
||||
(setcdr entry (cons (cons min max) (cdr entry)))))
|
||||
(setq nnsoup-group-alist-touched t))
|
||||
nnsoup-group-alist))
|
||||
|
||||
(defun nnsoup-write-active-file (&optional force)
|
||||
(when (and nnsoup-group-alist
|
||||
(or force
|
||||
nnsoup-group-alist-touched))
|
||||
(setq nnsoup-group-alist-touched nil)
|
||||
(with-temp-file nnsoup-active-file
|
||||
(gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
|
||||
(insert "\n")
|
||||
(gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
|
||||
(insert "\n"))))
|
||||
|
||||
(defun nnsoup-next-prefix ()
|
||||
"Return the next free prefix."
|
||||
(let (prefix)
|
||||
(while (or (file-exists-p
|
||||
(nnsoup-file (setq prefix (int-to-string
|
||||
nnsoup-current-prefix))))
|
||||
(file-exists-p (nnsoup-file prefix t)))
|
||||
(incf nnsoup-current-prefix))
|
||||
(incf nnsoup-current-prefix)
|
||||
prefix))
|
||||
|
||||
(defun nnsoup-file-name (dir file)
|
||||
"Return the full name of FILE (in any case) in DIR."
|
||||
(let* ((case-fold-search t)
|
||||
(files (directory-files dir t))
|
||||
(regexp (concat (regexp-quote file) "$")))
|
||||
(car (delq nil
|
||||
(mapcar
|
||||
(lambda (file)
|
||||
(if (string-match regexp file)
|
||||
file
|
||||
nil))
|
||||
files)))))
|
||||
|
||||
(defun nnsoup-read-areas ()
|
||||
(let ((areas-file (nnsoup-file-name nnsoup-tmp-directory "areas")))
|
||||
(when areas-file
|
||||
(save-excursion
|
||||
(set-buffer nntp-server-buffer)
|
||||
(let ((areas (gnus-soup-parse-areas areas-file))
|
||||
entry number area lnum cur-prefix file)
|
||||
;; Go through all areas in the new AREAS file.
|
||||
(while (setq area (pop areas))
|
||||
;; Change the name to the permanent name and move the files.
|
||||
(setq cur-prefix (nnsoup-next-prefix))
|
||||
(nnheader-message 5 "Incorporating file %s..." cur-prefix)
|
||||
(when (file-exists-p
|
||||
(setq file
|
||||
(expand-file-name
|
||||
(concat (gnus-soup-area-prefix area) ".IDX")
|
||||
nnsoup-tmp-directory)))
|
||||
(rename-file file (nnsoup-file cur-prefix)))
|
||||
(when (file-exists-p
|
||||
(setq file (expand-file-name
|
||||
(concat (gnus-soup-area-prefix area) ".MSG")
|
||||
nnsoup-tmp-directory)))
|
||||
(rename-file file (nnsoup-file cur-prefix t))
|
||||
(gnus-soup-set-area-prefix area cur-prefix)
|
||||
;; Find the number of new articles in this area.
|
||||
(setq number (nnsoup-number-of-articles area))
|
||||
(if (not (setq entry (assoc (gnus-soup-area-name area)
|
||||
nnsoup-group-alist)))
|
||||
;; If this is a new area (group), we just add this info to
|
||||
;; the group alist.
|
||||
(push (list (gnus-soup-area-name area)
|
||||
(cons 1 number)
|
||||
(list (cons 1 number) area))
|
||||
nnsoup-group-alist)
|
||||
;; There are already articles in this group, so we add this
|
||||
;; info to the end of the entry.
|
||||
(nconc entry (list (list (cons (1+ (setq lnum (cdadr entry)))
|
||||
(+ lnum number))
|
||||
area)))
|
||||
(setcdr (cadr entry) (+ lnum number))))))
|
||||
(nnsoup-write-active-file t)
|
||||
(delete-file areas-file)))))
|
||||
|
||||
(defun nnsoup-number-of-articles (area)
|
||||
(save-excursion
|
||||
(cond
|
||||
;; If the number is in the area info, we just return it.
|
||||
((gnus-soup-area-number area)
|
||||
(gnus-soup-area-number area))
|
||||
;; If there is an index file, we just count the lines.
|
||||
((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n)
|
||||
(set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
|
||||
(count-lines (point-min) (point-max)))
|
||||
;; We do it the hard way - re-searching through the message
|
||||
;; buffer.
|
||||
(t
|
||||
(set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
|
||||
(unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist)
|
||||
(nnsoup-dissect-buffer area))
|
||||
(length (cdr (assoc (gnus-soup-area-prefix area)
|
||||
nnsoup-article-alist)))))))
|
||||
|
||||
(defun nnsoup-dissect-buffer (area)
|
||||
(let ((mbox-delim (concat "^" message-unix-mail-delimiter))
|
||||
(format (gnus-soup-encoding-format (gnus-soup-area-encoding area)))
|
||||
(i 0)
|
||||
alist len)
|
||||
(goto-char (point-min))
|
||||
(cond
|
||||
;; rnews batch format
|
||||
((or (= format ?u)
|
||||
(= format ?n)) ;; Gnus back compatibility.
|
||||
(while (looking-at "^#! *rnews \\(+[0-9]+\\) *$")
|
||||
(forward-line 1)
|
||||
(push (list
|
||||
(incf i) (point)
|
||||
(progn
|
||||
(forward-char (string-to-number (match-string 1)))
|
||||
(point)))
|
||||
alist)))
|
||||
;; Unix mbox format
|
||||
((= format ?m)
|
||||
(while (looking-at mbox-delim)
|
||||
(forward-line 1)
|
||||
(push (list
|
||||
(incf i) (point)
|
||||
(progn
|
||||
(if (re-search-forward mbox-delim nil t)
|
||||
(beginning-of-line)
|
||||
(goto-char (point-max)))
|
||||
(point)))
|
||||
alist)))
|
||||
;; MMDF format
|
||||
((= format ?M)
|
||||
(while (looking-at "\^A\^A\^A\^A\n")
|
||||
(forward-line 1)
|
||||
(push (list
|
||||
(incf i) (point)
|
||||
(progn
|
||||
(if (search-forward "\n\^A\^A\^A\^A\n" nil t)
|
||||
(beginning-of-line)
|
||||
(goto-char (point-max)))
|
||||
(point)))
|
||||
alist)))
|
||||
;; Binary format
|
||||
((or (= format ?B) (= format ?b))
|
||||
(while (not (eobp))
|
||||
(setq len (+ (* (char-after (point)) (expt 2.0 24))
|
||||
(* (char-after (+ (point) 1)) (expt 2 16))
|
||||
(* (char-after (+ (point) 2)) (expt 2 8))
|
||||
(char-after (+ (point) 3))))
|
||||
(push (list
|
||||
(incf i) (+ (point) 4)
|
||||
(progn
|
||||
(forward-char (floor (+ len 4)))
|
||||
(point)))
|
||||
alist)))
|
||||
(t
|
||||
(error "Unknown format: %c" format)))
|
||||
(push (cons (gnus-soup-area-prefix area) alist) nnsoup-article-alist)))
|
||||
|
||||
(defun nnsoup-index-buffer (prefix &optional message)
|
||||
(let* ((file (concat prefix (if message ".MSG" ".IDX")))
|
||||
(buffer-name (concat " *nnsoup " file "*")))
|
||||
(or (get-buffer buffer-name) ; File already loaded.
|
||||
(when (file-exists-p (expand-file-name file nnsoup-directory))
|
||||
(save-excursion ; Load the file.
|
||||
(set-buffer (get-buffer-create buffer-name))
|
||||
(buffer-disable-undo)
|
||||
(push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
|
||||
(nnheader-insert-file-contents
|
||||
(expand-file-name file nnsoup-directory))
|
||||
(current-buffer))))))
|
||||
|
||||
(defun nnsoup-file (prefix &optional message)
|
||||
(expand-file-name
|
||||
(concat prefix (if message ".MSG" ".IDX"))
|
||||
nnsoup-directory))
|
||||
|
||||
(defun nnsoup-message-buffer (prefix)
|
||||
(nnsoup-index-buffer prefix 'msg))
|
||||
|
||||
(defun nnsoup-unpack-packets ()
|
||||
"Unpack all packets in `nnsoup-packet-directory'."
|
||||
(let ((packets (directory-files
|
||||
nnsoup-packet-directory t nnsoup-packet-regexp)))
|
||||
(dolist (packet packets)
|
||||
(nnheader-message 5 "nnsoup: unpacking %s..." packet)
|
||||
(if (not (gnus-soup-unpack-packet
|
||||
nnsoup-tmp-directory nnsoup-unpacker packet))
|
||||
(nnheader-message 5 "Couldn't unpack %s" packet)
|
||||
(delete-file packet)
|
||||
(nnsoup-read-areas)
|
||||
(nnheader-message 5 "Unpacking...done")))))
|
||||
|
||||
(defun nnsoup-narrow-to-article (article &optional area head)
|
||||
(let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
|
||||
(prefix (and area (gnus-soup-area-prefix (nth 1 area))))
|
||||
(msg-buf (and prefix (nnsoup-index-buffer prefix 'msg)))
|
||||
beg end)
|
||||
(when area
|
||||
(save-excursion
|
||||
(cond
|
||||
;; There is no MSG file.
|
||||
((null msg-buf)
|
||||
nil)
|
||||
;; We use the index file to find out where the article
|
||||
;; begins and ends.
|
||||
((and (= (gnus-soup-encoding-index
|
||||
(gnus-soup-area-encoding (nth 1 area)))
|
||||
?c)
|
||||
(file-exists-p (nnsoup-file prefix)))
|
||||
(set-buffer (nnsoup-index-buffer prefix))
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(forward-line (- article (caar area)))
|
||||
(setq beg (read (current-buffer)))
|
||||
(forward-line 1)
|
||||
(if (looking-at "[0-9]+")
|
||||
(progn
|
||||
(setq end (read (current-buffer)))
|
||||
(set-buffer msg-buf)
|
||||
(widen)
|
||||
(let ((format (gnus-soup-encoding-format
|
||||
(gnus-soup-area-encoding (nth 1 area)))))
|
||||
(goto-char end)
|
||||
(when (or (= format ?u) (= format ?n) (= format ?m))
|
||||
(setq end (progn (forward-line -1) (point))))))
|
||||
(set-buffer msg-buf))
|
||||
(widen)
|
||||
(narrow-to-region beg (or end (point-max))))
|
||||
(t
|
||||
(set-buffer msg-buf)
|
||||
(widen)
|
||||
(unless (assoc (gnus-soup-area-prefix (nth 1 area))
|
||||
nnsoup-article-alist)
|
||||
(nnsoup-dissect-buffer (nth 1 area)))
|
||||
(let ((entry (assq article (cdr (assoc (gnus-soup-area-prefix
|
||||
(nth 1 area))
|
||||
nnsoup-article-alist)))))
|
||||
(when entry
|
||||
(narrow-to-region (cadr entry) (caddr entry))))))
|
||||
(goto-char (point-min))
|
||||
(if (not head)
|
||||
()
|
||||
(narrow-to-region
|
||||
(point-min)
|
||||
(if (search-forward "\n\n" nil t)
|
||||
(1- (point))
|
||||
(point-max))))
|
||||
msg-buf))))
|
||||
|
||||
;;;###autoload
|
||||
(defun nnsoup-pack-replies ()
|
||||
"Make an outbound package of SOUP replies."
|
||||
(interactive)
|
||||
(unless (file-exists-p nnsoup-replies-directory)
|
||||
(nnheader-message 5 "No such directory: %s" nnsoup-replies-directory))
|
||||
;; Write all data buffers.
|
||||
(gnus-soup-save-areas)
|
||||
;; Write the active file.
|
||||
(nnsoup-write-active-file)
|
||||
;; Write the REPLIES file.
|
||||
(nnsoup-write-replies)
|
||||
;; Check whether there is anything here.
|
||||
(when (null (directory-files nnsoup-replies-directory nil "\\.MSG$"))
|
||||
(error "No files to pack"))
|
||||
;; Pack all these files into a SOUP packet.
|
||||
(gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
|
||||
|
||||
(defun nnsoup-write-replies ()
|
||||
"Write the REPLIES file."
|
||||
(when nnsoup-replies-list
|
||||
(gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)
|
||||
(setq nnsoup-replies-list nil)))
|
||||
|
||||
(defun nnsoup-article-to-area (article group)
|
||||
"Return the area that ARTICLE in GROUP is located in."
|
||||
(let ((areas (cddr (assoc group nnsoup-group-alist))))
|
||||
(while (and areas (< (cdar (car areas)) article))
|
||||
(setq areas (cdr areas)))
|
||||
(and areas (car areas))))
|
||||
|
||||
(defvar nnsoup-old-functions
|
||||
(list message-send-mail-real-function message-send-news-function))
|
||||
|
||||
;;;###autoload
|
||||
(defun nnsoup-set-variables ()
|
||||
"Use the SOUP methods for posting news and mailing mail."
|
||||
(interactive)
|
||||
(setq message-send-news-function 'nnsoup-request-post)
|
||||
(setq message-send-mail-real-function 'nnsoup-request-mail))
|
||||
|
||||
;;;###autoload
|
||||
(defun nnsoup-revert-variables ()
|
||||
"Revert posting and mailing methods to the standard Emacs methods."
|
||||
(interactive)
|
||||
(setq message-send-mail-real-function (car nnsoup-old-functions))
|
||||
(setq message-send-news-function (cadr nnsoup-old-functions)))
|
||||
|
||||
(defun nnsoup-store-reply (kind)
|
||||
;; Mostly stolen from `message.el'.
|
||||
(require 'mail-utils)
|
||||
(let ((tembuf (generate-new-buffer " message temp"))
|
||||
(case-fold-search nil)
|
||||
delimline
|
||||
(mailbuf (current-buffer)))
|
||||
(unwind-protect
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(message-narrow-to-headers)
|
||||
(if (equal kind "mail")
|
||||
(message-generate-headers message-required-mail-headers)
|
||||
(message-generate-headers message-required-news-headers)))
|
||||
(set-buffer tembuf)
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring mailbuf)
|
||||
;; Remove some headers.
|
||||
(save-restriction
|
||||
(message-narrow-to-headers)
|
||||
;; Remove some headers.
|
||||
(message-remove-header message-ignored-mail-headers t))
|
||||
(goto-char (point-max))
|
||||
;; require one newline at the end.
|
||||
(or (= (preceding-char) ?\n)
|
||||
(insert ?\n))
|
||||
(let ((case-fold-search t))
|
||||
;; Change header-delimiter to be what sendmail expects.
|
||||
(goto-char (point-min))
|
||||
(re-search-forward
|
||||
(concat "^" (regexp-quote mail-header-separator) "\n"))
|
||||
(replace-match "\n")
|
||||
(backward-char 1)
|
||||
(setq delimline (point-marker))
|
||||
(goto-char (1+ delimline))
|
||||
(let ((msg-buf
|
||||
(gnus-soup-store
|
||||
nnsoup-replies-directory
|
||||
(nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
|
||||
nnsoup-replies-index-type))
|
||||
(num 0))
|
||||
(when (and msg-buf (bufferp msg-buf))
|
||||
(save-excursion
|
||||
(set-buffer msg-buf)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^#! *rnews" nil t)
|
||||
(incf num))
|
||||
(when nnsoup-always-save
|
||||
(save-buffer)))
|
||||
(nnheader-message 5 "Stored %d messages" num)))
|
||||
(nnsoup-write-replies)
|
||||
(kill-buffer tembuf))))))
|
||||
|
||||
(defun nnsoup-kind-to-prefix (kind)
|
||||
(unless nnsoup-replies-list
|
||||
(setq nnsoup-replies-list
|
||||
(gnus-soup-parse-replies
|
||||
(expand-file-name "REPLIES" nnsoup-replies-directory))))
|
||||
(let ((replies nnsoup-replies-list))
|
||||
(while (and replies
|
||||
(not (string= kind (gnus-soup-reply-kind (car replies)))))
|
||||
(setq replies (cdr replies)))
|
||||
(if replies
|
||||
(gnus-soup-reply-prefix (car replies))
|
||||
(push (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
|
||||
kind
|
||||
(format "%c%c%c"
|
||||
nnsoup-replies-format-type
|
||||
nnsoup-replies-index-type
|
||||
(if (string= kind "news")
|
||||
?n ?m)))
|
||||
nnsoup-replies-list)
|
||||
(gnus-soup-reply-prefix (car nnsoup-replies-list)))))
|
||||
|
||||
(defun nnsoup-make-active ()
|
||||
"(Re-)create the SOUP active file."
|
||||
(interactive)
|
||||
(let ((files (sort (directory-files nnsoup-directory t "IDX$")
|
||||
(lambda (f1 f2)
|
||||
(< (progn (string-match "/\\([0-9]+\\)\\." f1)
|
||||
(string-to-number (match-string 1 f1)))
|
||||
(progn (string-match "/\\([0-9]+\\)\\." f2)
|
||||
(string-to-number (match-string 1 f2)))))))
|
||||
active group lines ident elem min)
|
||||
(set-buffer (get-buffer-create " *nnsoup work*"))
|
||||
(dolist (file files)
|
||||
(nnheader-message 5 "Doing %s..." file)
|
||||
(erase-buffer)
|
||||
(nnheader-insert-file-contents file)
|
||||
(goto-char (point-min))
|
||||
(if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
|
||||
(setq group "unknown")
|
||||
(setq group (match-string 2)))
|
||||
(setq lines (count-lines (point-min) (point-max)))
|
||||
(setq ident (progn (string-match
|
||||
"/\\([0-9]+\\)\\." file)
|
||||
(match-string 1 file)))
|
||||
(if (not (setq elem (assoc group active)))
|
||||
(push (list group (cons 1 lines)
|
||||
(list (cons 1 lines)
|
||||
(vector ident group "ucm" "" lines)))
|
||||
active)
|
||||
(nconc elem
|
||||
(list
|
||||
(list (cons (1+ (setq min (cdadr elem)))
|
||||
(+ min lines))
|
||||
(vector ident group "ucm" "" lines))))
|
||||
(setcdr (cadr elem) (+ min lines))))
|
||||
(nnheader-message 5 "")
|
||||
(setq nnsoup-group-alist active)
|
||||
(nnsoup-write-active-file t)))
|
||||
|
||||
(defun nnsoup-delete-unreferenced-message-files ()
|
||||
"Delete any *.MSG and *.IDX files that aren't known by nnsoup."
|
||||
(interactive)
|
||||
(let* ((known (apply 'nconc (mapcar
|
||||
(lambda (ga)
|
||||
(mapcar
|
||||
(lambda (area)
|
||||
(gnus-soup-area-prefix (cadr area)))
|
||||
(cddr ga)))
|
||||
nnsoup-group-alist)))
|
||||
(regexp "\\.MSG$\\|\\.IDX$")
|
||||
(files (directory-files nnsoup-directory nil regexp))
|
||||
non-files)
|
||||
;; Find all files that aren't known by nnsoup.
|
||||
(dolist (file files)
|
||||
(string-match regexp file)
|
||||
(unless (member (substring file 0 (match-beginning 0)) known)
|
||||
(push file non-files)))
|
||||
;; Sort and delete the files.
|
||||
(setq non-files (sort non-files 'string<))
|
||||
(map-y-or-n-p "Delete file %s? "
|
||||
(lambda (file) (delete-file
|
||||
(expand-file-name file nnsoup-directory)))
|
||||
non-files)))
|
||||
|
||||
(provide 'nnsoup)
|
||||
|
||||
;; arch-tag: b0451389-5703-4450-9425-f66f6b38c828
|
||||
;;; nnsoup.el ends here
|
||||
@ -1,480 +0,0 @@
|
||||
;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system
|
||||
|
||||
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
|
||||
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
;; Keywords: news
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Note: You need to have `url' and `w3' installed for this
|
||||
;; backend to work.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(require 'nnoo)
|
||||
(require 'message)
|
||||
(require 'gnus-util)
|
||||
(require 'gnus)
|
||||
(require 'nnmail)
|
||||
(require 'mm-util)
|
||||
(require 'mm-url)
|
||||
(require 'nnweb)
|
||||
(require 'parse-time)
|
||||
(autoload 'w3-parse-buffer "w3-parse")
|
||||
|
||||
(nnoo-declare nnultimate)
|
||||
|
||||
(defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/")
|
||||
"Where nnultimate will save its files.")
|
||||
|
||||
(defvoo nnultimate-address ""
|
||||
"The address of the Ultimate bulletin board.")
|
||||
|
||||
;;; Internal variables
|
||||
|
||||
(defvar nnultimate-groups-alist nil)
|
||||
(defvoo nnultimate-groups nil)
|
||||
(defvoo nnultimate-headers nil)
|
||||
(defvoo nnultimate-articles nil)
|
||||
(defvar nnultimate-table-regexp
|
||||
"postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio")
|
||||
|
||||
;;; Interface functions
|
||||
|
||||
(nnoo-define-basics nnultimate)
|
||||
|
||||
(deffoo nnultimate-retrieve-headers (articles &optional group server fetch-old)
|
||||
(nnultimate-possibly-change-server group server)
|
||||
(unless gnus-nov-is-evil
|
||||
(let* ((last (car (last articles)))
|
||||
(did nil)
|
||||
(start 1)
|
||||
(entry (assoc group nnultimate-groups))
|
||||
(sid (nth 2 entry))
|
||||
(topics (nth 4 entry))
|
||||
(mapping (nth 5 entry))
|
||||
(old-total (or (nth 6 entry) 1))
|
||||
(furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000")
|
||||
(furls (list (concat nnultimate-address (format furl sid))))
|
||||
(nnultimate-table-regexp
|
||||
"postings.*editpost\\|forumdisplay\\|getbio")
|
||||
headers article subject score from date lines parent point
|
||||
contents tinfo fetchers map elem a href garticles topic old-max
|
||||
inc datel table current-page total-contents pages
|
||||
farticles forum-contents parse furl-fetched mmap farticle)
|
||||
(setq map mapping)
|
||||
(while (and (setq article (car articles))
|
||||
map)
|
||||
;; Skip past the articles in the map until we reach the
|
||||
;; article we're looking for.
|
||||
(while (and map
|
||||
(or (> article (caar map))
|
||||
(< (cadar map) (caar map))))
|
||||
(pop map))
|
||||
(when (setq mmap (car map))
|
||||
(setq farticle -1)
|
||||
(while (and article
|
||||
(<= article (nth 1 mmap)))
|
||||
;; Do we already have a fetcher for this topic?
|
||||
(if (setq elem (assq (nth 2 mmap) fetchers))
|
||||
;; Yes, so we just add the spec to the end.
|
||||
(nconc elem (list (cons article
|
||||
(+ (nth 3 mmap) (incf farticle)))))
|
||||
;; No, so we add a new one.
|
||||
(push (list (nth 2 mmap)
|
||||
(cons article
|
||||
(+ (nth 3 mmap) (incf farticle))))
|
||||
fetchers))
|
||||
(pop articles)
|
||||
(setq article (car articles)))))
|
||||
;; Now we have the mapping from/to Gnus/nnultimate article numbers,
|
||||
;; so we start fetching the topics that we need to satisfy the
|
||||
;; request.
|
||||
(if (not fetchers)
|
||||
(save-excursion
|
||||
(set-buffer nntp-server-buffer)
|
||||
(erase-buffer))
|
||||
(setq nnultimate-articles nil)
|
||||
(mm-with-unibyte-buffer
|
||||
(dolist (elem fetchers)
|
||||
(setq pages 1
|
||||
current-page 1
|
||||
total-contents nil)
|
||||
(while (<= current-page pages)
|
||||
(erase-buffer)
|
||||
(setq subject (nth 2 (assq (car elem) topics)))
|
||||
(setq href (nth 3 (assq (car elem) topics)))
|
||||
(if (= current-page 1)
|
||||
(mm-url-insert href)
|
||||
(string-match "\\.html$" href)
|
||||
(mm-url-insert (concat (substring href 0 (match-beginning 0))
|
||||
"-" (number-to-string current-page)
|
||||
(match-string 0 href))))
|
||||
(goto-char (point-min))
|
||||
(setq contents
|
||||
(ignore-errors (w3-parse-buffer (current-buffer))))
|
||||
(setq table (nnultimate-find-forum-table contents))
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "topic is \\([0-9]+\\) pages" nil t)
|
||||
(setq pages (string-to-number (match-string 1))))
|
||||
(setq contents (cdr (nth 2 (car (nth 2 table)))))
|
||||
(setq total-contents (nconc total-contents contents))
|
||||
(incf current-page))
|
||||
(when t
|
||||
(let ((i 0))
|
||||
(dolist (co total-contents)
|
||||
(push (list (or (nnultimate-topic-article-to-article
|
||||
group (car elem) (incf i))
|
||||
1)
|
||||
co subject)
|
||||
nnultimate-articles))))
|
||||
(when nil
|
||||
(dolist (art (cdr elem))
|
||||
(when (nth (1- (cdr art)) total-contents)
|
||||
(push (list (car art)
|
||||
(nth (1- (cdr art)) total-contents)
|
||||
subject)
|
||||
nnultimate-articles))))))
|
||||
(setq nnultimate-articles
|
||||
(sort nnultimate-articles 'car-less-than-car))
|
||||
;; Now we have all the articles, conveniently in an alist
|
||||
;; where the key is the Gnus article number.
|
||||
(dolist (articlef nnultimate-articles)
|
||||
(setq article (nth 0 articlef)
|
||||
contents (nth 1 articlef)
|
||||
subject (nth 2 articlef))
|
||||
(setq from (mapconcat 'identity
|
||||
(nnweb-text (car (nth 2 contents)))
|
||||
" ")
|
||||
datel (nnweb-text (nth 2 (car (cdr (nth 2 contents))))))
|
||||
(while datel
|
||||
(when (string-match "Posted" (car datel))
|
||||
(setq date (substring (car datel) (match-end 0))
|
||||
datel nil))
|
||||
(pop datel))
|
||||
(when date
|
||||
(setq date (delete "" (split-string date "[-, \n\t\r ]")))
|
||||
(setq date
|
||||
(if (or (member "AM" date)
|
||||
(member "PM" date))
|
||||
(format
|
||||
"%s %s %s %s"
|
||||
(nth 1 date)
|
||||
(if (and (>= (length (nth 0 date)) 3)
|
||||
(assoc (downcase
|
||||
(substring (nth 0 date) 0 3))
|
||||
parse-time-months))
|
||||
(substring (nth 0 date) 0 3)
|
||||
(car (rassq (string-to-number (nth 0 date))
|
||||
parse-time-months)))
|
||||
(nth 2 date) (nth 3 date))
|
||||
(format "%s %s %s %s"
|
||||
(car (rassq (string-to-number (nth 1 date))
|
||||
parse-time-months))
|
||||
(nth 0 date) (nth 2 date) (nth 3 date)))))
|
||||
(push
|
||||
(cons
|
||||
article
|
||||
(make-full-mail-header
|
||||
article subject
|
||||
from (or date "")
|
||||
(concat "<" (number-to-string sid) "%"
|
||||
(number-to-string article)
|
||||
"@ultimate." server ">")
|
||||
"" 0
|
||||
(/ (length (mapconcat
|
||||
'identity
|
||||
(nnweb-text
|
||||
(cdr (nth 2 (nth 1 (nth 2 contents)))))
|
||||
""))
|
||||
70)
|
||||
nil nil))
|
||||
headers))
|
||||
(setq nnultimate-headers (sort headers 'car-less-than-car))
|
||||
(save-excursion
|
||||
(set-buffer nntp-server-buffer)
|
||||
(mm-with-unibyte-current-buffer
|
||||
(erase-buffer)
|
||||
(dolist (header nnultimate-headers)
|
||||
(nnheader-insert-nov (cdr header))))))
|
||||
'nov)))
|
||||
|
||||
(defun nnultimate-topic-article-to-article (group topic article)
|
||||
(catch 'found
|
||||
(dolist (elem (nth 5 (assoc group nnultimate-groups)))
|
||||
(when (and (= topic (nth 2 elem))
|
||||
(>= article (nth 3 elem))
|
||||
(< article (+ (- (nth 1 elem) (nth 0 elem)) 1
|
||||
(nth 3 elem))))
|
||||
(throw 'found
|
||||
(+ (nth 0 elem) (- article (nth 3 elem))))))))
|
||||
|
||||
(deffoo nnultimate-request-group (group &optional server dont-check)
|
||||
(nnultimate-possibly-change-server nil server)
|
||||
(when (not nnultimate-groups)
|
||||
(nnultimate-request-list))
|
||||
(unless dont-check
|
||||
(nnultimate-create-mapping group))
|
||||
(let ((elem (assoc group nnultimate-groups)))
|
||||
(cond
|
||||
((not elem)
|
||||
(nnheader-report 'nnultimate "Group does not exist"))
|
||||
(t
|
||||
(nnheader-report 'nnultimate "Opened group %s" group)
|
||||
(nnheader-insert
|
||||
"211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
|
||||
(prin1-to-string group))))))
|
||||
|
||||
(deffoo nnultimate-request-close ()
|
||||
(setq nnultimate-groups-alist nil
|
||||
nnultimate-groups nil))
|
||||
|
||||
(deffoo nnultimate-request-article (article &optional group server buffer)
|
||||
(nnultimate-possibly-change-server group server)
|
||||
(let ((contents (cdr (assq article nnultimate-articles))))
|
||||
(setq contents (cddr (nth 2 (nth 1 (nth 2 (car contents))))))
|
||||
(when contents
|
||||
(save-excursion
|
||||
(set-buffer (or buffer nntp-server-buffer))
|
||||
(erase-buffer)
|
||||
(nnweb-insert-html (cons 'p (cons nil (list contents))))
|
||||
(goto-char (point-min))
|
||||
(insert "Content-Type: text/html\nMIME-Version: 1.0\n")
|
||||
(let ((header (cdr (assq article nnultimate-headers))))
|
||||
(mm-with-unibyte-current-buffer
|
||||
(nnheader-insert-header header)))
|
||||
(nnheader-report 'nnultimate "Fetched article %s" article)
|
||||
(cons group article)))))
|
||||
|
||||
(deffoo nnultimate-request-list (&optional server)
|
||||
(nnultimate-possibly-change-server nil server)
|
||||
(mm-with-unibyte-buffer
|
||||
(mm-url-insert
|
||||
(if (string-match "/$" nnultimate-address)
|
||||
(concat nnultimate-address "Ultimate.cgi")
|
||||
nnultimate-address))
|
||||
(let ((contents (nth 2 (car (nth 2
|
||||
(nnultimate-find-forum-table
|
||||
(w3-parse-buffer (current-buffer)))))))
|
||||
sid elem description articles a href group forum
|
||||
a1 a2)
|
||||
(dolist (row contents)
|
||||
(setq row (nth 2 row))
|
||||
(when (setq a (nnweb-parse-find 'a row))
|
||||
(setq group (car (last (nnweb-text a)))
|
||||
href (cdr (assq 'href (nth 1 a))))
|
||||
(setq description (car (last (nnweb-text (nth 1 row)))))
|
||||
(setq a1 (car (last (nnweb-text (nth 2 row)))))
|
||||
(setq a2 (car (last (nnweb-text (nth 3 row)))))
|
||||
(when (string-match "^[0-9]+$" a1)
|
||||
(setq articles (string-to-number a1)))
|
||||
(when (and a2 (string-match "^[0-9]+$" a2))
|
||||
(setq articles (max articles (string-to-number a2))))
|
||||
(when href
|
||||
(string-match "number=\\([0-9]+\\)" href)
|
||||
(setq forum (string-to-number (match-string 1 href)))
|
||||
(if (setq elem (assoc group nnultimate-groups))
|
||||
(setcar (cdr elem) articles)
|
||||
(push (list group articles forum description nil nil nil nil)
|
||||
nnultimate-groups))))))
|
||||
(nnultimate-write-groups)
|
||||
(nnultimate-generate-active)
|
||||
t))
|
||||
|
||||
(deffoo nnultimate-request-newgroups (date &optional server)
|
||||
(nnultimate-possibly-change-server nil server)
|
||||
(nnultimate-generate-active)
|
||||
t)
|
||||
|
||||
(nnoo-define-skeleton nnultimate)
|
||||
|
||||
;;; Internal functions
|
||||
|
||||
(defun nnultimate-prune-days (group time)
|
||||
"Compute the number of days to fetch info for."
|
||||
(let ((old-time (nth 7 (assoc group nnultimate-groups))))
|
||||
(if (null old-time)
|
||||
1000
|
||||
(- (time-to-days time) (time-to-days old-time)))))
|
||||
|
||||
(defun nnultimate-create-mapping (group)
|
||||
(let* ((entry (assoc group nnultimate-groups))
|
||||
(sid (nth 2 entry))
|
||||
(topics (nth 4 entry))
|
||||
(mapping (nth 5 entry))
|
||||
(old-total (or (nth 6 entry) 1))
|
||||
(current-time (current-time))
|
||||
(furl
|
||||
(concat "forumdisplay.cgi?action=topics&number=%d&DaysPrune="
|
||||
(number-to-string
|
||||
(nnultimate-prune-days group current-time))))
|
||||
(furls (list (concat nnultimate-address (format furl sid))))
|
||||
contents forum-contents furl-fetched a subject href
|
||||
garticles topic tinfo old-max inc parse)
|
||||
(mm-with-unibyte-buffer
|
||||
(while furls
|
||||
(erase-buffer)
|
||||
(mm-url-insert (pop furls))
|
||||
(goto-char (point-min))
|
||||
(setq parse (w3-parse-buffer (current-buffer)))
|
||||
(setq contents
|
||||
(cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table
|
||||
parse))))))
|
||||
(setq forum-contents (nconc contents forum-contents))
|
||||
(unless furl-fetched
|
||||
(setq furl-fetched t)
|
||||
;; On the first time through this loop, we find all the
|
||||
;; forum URLs.
|
||||
(dolist (a (nnweb-parse-find-all 'a parse))
|
||||
(let ((href (cdr (assq 'href (nth 1 a)))))
|
||||
(when (and href
|
||||
(string-match "forumdisplay.*startpoint" href))
|
||||
(push href furls))))
|
||||
(setq furls (nreverse furls))))
|
||||
;; The main idea here is to map Gnus article numbers to
|
||||
;; nnultimate article numbers. Say there are three topics in
|
||||
;; this forum, the first with 4 articles, the seconds with 2,
|
||||
;; and the third with 1. Then this will translate into 7 Gnus
|
||||
;; article numbers, where 1-4 comes from the first topic, 5-6
|
||||
;; from the second and 7 from the third. Now, then next time
|
||||
;; the group is entered, there's 2 new articles in topic one
|
||||
;; and 1 in topic three. Then Gnus article number 8-9 be 5-6
|
||||
;; in topic one and 10 will be the 2 in topic three.
|
||||
(dolist (row (nreverse forum-contents))
|
||||
(setq row (nth 2 row))
|
||||
(when (setq a (nnweb-parse-find 'a row))
|
||||
(setq subject (car (last (nnweb-text a)))
|
||||
href (cdr (assq 'href (nth 1 a))))
|
||||
(let ((artlist (nreverse (nnweb-text row)))
|
||||
art)
|
||||
(while (and (not art)
|
||||
artlist)
|
||||
(when (string-match "^[0-9]+$" (car artlist))
|
||||
(setq art (1+ (string-to-number (car artlist)))))
|
||||
(pop artlist))
|
||||
(setq garticles art))
|
||||
(when garticles
|
||||
(string-match "/\\([0-9]+\\).html" href)
|
||||
(setq topic (string-to-number (match-string 1 href)))
|
||||
(if (setq tinfo (assq topic topics))
|
||||
(progn
|
||||
(setq old-max (cadr tinfo))
|
||||
(setcar (cdr tinfo) garticles))
|
||||
(setq old-max 0)
|
||||
(push (list topic garticles subject href) topics)
|
||||
(setcar (nthcdr 4 entry) topics))
|
||||
(when (not (= old-max garticles))
|
||||
(setq inc (- garticles old-max))
|
||||
(setq mapping (nconc mapping
|
||||
(list
|
||||
(list
|
||||
old-total (1- (incf old-total inc))
|
||||
topic (1+ old-max)))))
|
||||
(incf old-max inc)
|
||||
(setcar (nthcdr 5 entry) mapping)
|
||||
(setcar (nthcdr 6 entry) old-total))))))
|
||||
(setcar (nthcdr 7 entry) current-time)
|
||||
(setcar (nthcdr 1 entry) (1- old-total))
|
||||
(nnultimate-write-groups)
|
||||
mapping))
|
||||
|
||||
(defun nnultimate-possibly-change-server (&optional group server)
|
||||
(nnultimate-init server)
|
||||
(when (and server
|
||||
(not (nnultimate-server-opened server)))
|
||||
(nnultimate-open-server server))
|
||||
(unless nnultimate-groups-alist
|
||||
(nnultimate-read-groups)
|
||||
(setq nnultimate-groups (cdr (assoc nnultimate-address
|
||||
nnultimate-groups-alist)))))
|
||||
|
||||
(deffoo nnultimate-open-server (server &optional defs connectionless)
|
||||
(nnheader-init-server-buffer)
|
||||
(if (nnultimate-server-opened server)
|
||||
t
|
||||
(unless (assq 'nnultimate-address defs)
|
||||
(setq defs (append defs (list (list 'nnultimate-address server)))))
|
||||
(nnoo-change-server 'nnultimate server defs)))
|
||||
|
||||
(defun nnultimate-read-groups ()
|
||||
(setq nnultimate-groups-alist nil)
|
||||
(let ((file (expand-file-name "groups" nnultimate-directory)))
|
||||
(when (file-exists-p file)
|
||||
(mm-with-unibyte-buffer
|
||||
(insert-file-contents file)
|
||||
(goto-char (point-min))
|
||||
(setq nnultimate-groups-alist (read (current-buffer)))))))
|
||||
|
||||
(defun nnultimate-write-groups ()
|
||||
(setq nnultimate-groups-alist
|
||||
(delq (assoc nnultimate-address nnultimate-groups-alist)
|
||||
nnultimate-groups-alist))
|
||||
(push (cons nnultimate-address nnultimate-groups)
|
||||
nnultimate-groups-alist)
|
||||
(with-temp-file (expand-file-name "groups" nnultimate-directory)
|
||||
(prin1 nnultimate-groups-alist (current-buffer))))
|
||||
|
||||
(defun nnultimate-init (server)
|
||||
"Initialize buffers and such."
|
||||
(unless (file-exists-p nnultimate-directory)
|
||||
(gnus-make-directory nnultimate-directory)))
|
||||
|
||||
(defun nnultimate-generate-active ()
|
||||
(save-excursion
|
||||
(set-buffer nntp-server-buffer)
|
||||
(erase-buffer)
|
||||
(dolist (elem nnultimate-groups)
|
||||
(insert (prin1-to-string (car elem))
|
||||
" " (number-to-string (cadr elem)) " 1 y\n"))))
|
||||
|
||||
(defun nnultimate-find-forum-table (contents)
|
||||
(catch 'found
|
||||
(nnultimate-find-forum-table-1 contents)))
|
||||
|
||||
(defun nnultimate-find-forum-table-1 (contents)
|
||||
(dolist (element contents)
|
||||
(unless (stringp element)
|
||||
(when (and (eq (car element) 'table)
|
||||
(nnultimate-forum-table-p element))
|
||||
(throw 'found element))
|
||||
(when (nth 2 element)
|
||||
(nnultimate-find-forum-table-1 (nth 2 element))))))
|
||||
|
||||
(defun nnultimate-forum-table-p (parse)
|
||||
(when (not (apply 'gnus-or
|
||||
(mapcar
|
||||
(lambda (p)
|
||||
(nnweb-parse-find 'table p))
|
||||
(nth 2 parse))))
|
||||
(let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
|
||||
case-fold-search)
|
||||
(when (and href (string-match nnultimate-table-regexp href))
|
||||
t))))
|
||||
|
||||
(provide 'nnultimate)
|
||||
|
||||
;; Local Variables:
|
||||
;; coding: iso-8859-1
|
||||
;; End:
|
||||
|
||||
;; arch-tag: ab6bfc45-8fe1-4647-9c78-41050eb152b8
|
||||
;;; nnultimate.el ends here
|
||||
Loading…
Reference in New Issue
Block a user