cgit.sxemacs.org Git - gnus/blob - lisp/nnrss.el

   1 ;;; nnrss.el --- interfacing with RSS
   2 ;; Copyright (C) 2001  Free Software Foundation, Inc.
   3
   4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
   5 ;; Keywords: RSS
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published
  11 ;; by the Free Software Foundation; either version 2, or (at your
  12 ;; option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (eval-when-compile (require 'cl))
  29
  30 (require 'gnus)
  31 (require 'nnoo)
  32 (require 'nnmail)
  33 (require 'message)
  34 (require 'mm-util)
  35 (require 'gnus-util)
  36 (require 'time-date)
  37 (require 'rfc2231)
  38 (require 'mm-url)
  39 (eval-when-compile
  40   (ignore-errors
  41     (require 'xml)))
  42 ;; Report failure to find w3 at load time if appropriate.
  43 (eval '(require 'xml))
  44
  45 (nnoo-declare nnrss)
  46
  47 (defvoo nnrss-directory (nnheader-concat gnus-directory "rss/")
  48   "Where nnrss will save its files.")
  49
  50 ;; (group max rss-url)
  51 (defvoo nnrss-server-data nil)
  52
  53 ;; (num timestamp url subject author date extra)
  54 (defvoo nnrss-group-data nil)
  55 (defvoo nnrss-group-max 0)
  56 (defvoo nnrss-group-min 1)
  57 (defvoo nnrss-group nil)
  58 (defvoo nnrss-group-hashtb nil)
  59 (defvoo nnrss-status-string "")
  60
  61 (defconst nnrss-version "nnrss 1.0")
  62
  63 (defvar nnrss-group-alist
  64   '(("MacWeek"
  65      "http://macweek.zdnet.com/macweek.xml"
  66      "The Macintosh news authority.")
  67     ("Linux.Weekly.News"
  68      "http://lwn.net/headlines/rss")
  69     ("Motley.Fool"
  70      "http://www.fool.com/About/headlines/rss_headlines.asp")
  71     ("NewsForge.rdf"
  72      "http://www.newsforge.com/newsforge.rdf")
  73     ("Slashdot"
  74      "http://www.slashdot.com/slashdot.rdf")
  75     ("CNN"
  76      "http://www.cnn.com/cnn.rss"
  77      "The world's news leader.")
  78     ("FreshMeat"
  79      "http://freshmeat.net/backend/fm-releases.rdf"
  80      "The one-stop-shop for all your Linux software needs.")
  81     ("The.Guardian.newspaper"
  82      "http://www.guardianunlimited.co.uk/rss/1,,,00.xml"
  83      "Intelligent news and comment throughout the day from The Guardian newspaper.")
  84     ("MonkeyFist.rdf"
  85      "http://monkeyfist.com/rdf.php3"
  86      "News and opinion on politics, technology, and eclectic miscellany.")
  87     ("NewsForge"
  88      "http://www.newsforge.com/newsforge.rss")
  89     ("Reuters.Health"
  90      "http://www.reutershealth.com/eline.rss"
  91      "Consumer-oriented health-related news stories.")
  92     ("Salon"
  93      "http://www.salon.com/feed/RDF/salon_use.rdf")
  94     ("Wired"
  95      "http://www.wired.com/news_drop/netcenter/netcenter.rdf")
  96     ("ITN"
  97      "http://www.itn.co.uk/itn.rdf")
  98     ("Meerkat"
  99      "http://www.oreillynet.com/meerkat/?_fl=rss10"
 100      "An Open Wire Service")
 101     ("MonkeyFist"
 102      "http://monkeyfist.com/rss1.php3"
 103      "News and opinion on politics, technology, and eclectic miscellany.")
 104     ("Reuters.Health.rdf"
 105      "http://www.reutershealth.com/eline.rdf"
 106      "Consumer-oriented health-related news stories.")
 107 ;;("4xt" "http://4xt.org/news/general.rss10" "Resources for XT users.")
 108     ("Aaronland" "http://aaronland.net/xml/abhb.rdf" "A boy and his basement.")
 109     ("Art of the Mix" "http://www.artofthemix.org/xml/rss.asp" "A website devoted to the art of making mixed tapes and cds.")
 110     ("Dave Beckett's RDF Resource Guide" "http://www.ilrt.bristol.ac.uk/discovery/rdf/resources/rss.rdf" "A comprehensive guide to resources about RDF.")
 111     ("David Chess" "http://www.davidchess.com/words/log.rss" "Mostly-daily musings on philosophy, children, culture, technology, the emergence of life from matter, chocolate, Nomic, and all that sort of thing.")
 112 ;;("Dublin Core Metadata Intitiative" "http://www.dublincore.org/news.rss" "Latest news from DCMI.")
 113     ("Figby Articles" "http://www.figby.com/index-rss.php" "A weblog with daily stories about technology, books and publishing, privacy, science, and occasional humor.")
 114 ;;("Figby News" "http://www.figby.com/news.php" "Categorized RSS feeds from various sources.")
 115     ("Figby Quickies" "http://www.figby.com/quickies-rss.php" "Quick commented links to other sites from Figby.com.")
 116     ("Flutterby!" "http://www.flutterby.com/main.rdf" "News and views from Dan Lyke.")
 117     ("Groovelog" "http://groovelog.agora.co.uk/groove+log/groovelog.nsf/today.rss.xml" "The open-access groove users' weblog.")
 118 ;;("Groovelog.rss10" "http://groovelog.agora.co.uk/groove+log/groovelog.nsf/today.rss10.xml" "The open-access groove users' weblog.")
 119     ("Hit or Miss" "http://hit-or-miss.org/rss/" "Daily weblog and journal.")
 120 ;;("Internet.com Feeds" "http://www.webreference.com/services/news/" "News from ")
 121     ("Larkfarm News" "http://www.larkfarm.com/Larkfarm.rdf" "Mike Gunderloy's web site.")
 122     ("Latest RFCs" "http://x42.com/rss/rfc.rss")
 123     ("Linux Today" "http://linuxtoday.com/backend/biglt.rss")
 124     ("Linux Today.rdf" "http://linuxtoday.com/backend/my-netscape10.rdf")
 125     ("More Like This WebLog" "http://www.whump.com/moreLikeThis/RSS" "Because the more you know, the more jokes you get.")
 126     ("Motivational Quotes of the Day" "http://www.quotationspage.com/data/mqotd.rss" "Four motivational quotations each day from the Quotations Page.")
 127 ;;("My Netscape Network" "http://www.dmoz.org/Netscape/My_Netscape_Network/")
 128     ;;("My UserLand" "http://my.userland.com/choose")
 129     ("Network World Fusion NetFlash" "http://www.nwfusion.com/netflash.rss" "Daily breaking news about networking products, technologies and services.")
 130 ;;("News Feeds" "http://newsfeeds.manilasites.com/" "Jeff Barr highlights high quality RSS feeds.")
 131     ;;("News Is Free Export" "http://www.newsisfree.com/export.php3")
 132     ("News Is Free" "http://www.newsisfree.com/news.rdf.php3")
 133 ;;("News is Free XML Export" "http://www.newsisfree.com/ocs/directory.xml")
 134     ("O'Reilly Network Articles" "http://www.oreillynet.com/cs/rss/query/q/260?x-ver=1.0")
 135     ("Quotes of the Day" "http://www.quotationspage.com/data/qotd.rss" "Four humorous quotations each day from the Quotations Page.")
 136     ("RDF Interest Group" "http://ilrt.org/discovery/rdf-dev/roads/cgi-bin/desire/ig2rss?list=www-rdf-interest" "An experimental channel scraped from the RDF Interest Group mail archives.")
 137     ("RDF Logic List" "http://ilrt.org/discovery/rdf-dev/roads/cgi-bin/desire/ig2rss?list=www-rdf-logic" "An experimental channel scraped from the RDF Logic mail archives.")
 138     ("RSS Info" "http://www.blogspace.com/rss/rss10" "News and information on the RSS format")
 139 ;;("RSS-DEV listing" "http://www.egroups.com/links/rss-dev/Feeds_000966335046/" "A listing of RSS files from the RSS-DEV list.")
 140     ("Semantic Web List" "http://ilrt.org/discovery/rdf-dev/roads/cgi-bin/desire/ig2rss?list=semantic-web" "An experimental channel scraped from the W3C's Semantic Web mail archives.")
 141 ;;("Sherch!" "http://www.sherch.com/~pldms/cgi-bin/sherch.pl" "Sherlock for the rest of us.")
 142 ;;("Street Fusion Archived Financial Webcasts" "http://partners.streetfusion.com/rdf/archive.rdf")
 143 ;;("Street Fusion Upcoming Financial Webcasts" "http://partners.streetfusion.com/rdf/live.rdf")
 144 ;;("TNL.net newsletter" "http://www.tnl.net/newsletter/channel100.asp" "A newsletter about Internet technology and issues.")
 145     ("W3C" "http://www.w3.org/2000/08/w3c-synd/home.rss" "The latest news at the World Wide Web Consortium.")
 146 ;;("XML News: RSS Live Content" "http://www.xmlnews.org/RSS/content.html" "A listing of well-known RSS feeds.")
 147     ("|fr| XMLfr" "http://xmlfr.org/actualites/general.rss10"
 148      "French speaking portal site dedicated to XML.")
 149     ("XMLhack" "http://xmlhack.com/rss10.php"
 150      "Developer news from the XML community.")
 151     ("The Register"
 152      "http://www.theregister.co.uk/tonys/slashdot.rdf"
 153      "The Register -- Biting the hand that feeds IT.")
 154     ("|de| Heise-Ticker"
 155      "http://www.heise.de/newsticker/heise.rdf"
 156      "German news ticker about technology.")
 157     ("|de| Telepolis News"
 158      "http://www.heise.de/tp/news.rdf"
 159      "German background news about technology.")
 160     ("Kuro5hin"
 161      "http://www.kuro5hin.org/backend.rdf"
 162      "Technology and culture, from the trenches.")
 163     ("JabberCentral"
 164      "http://www.jabbercentral.com/rss.php"
 165      "News around the Jabber instant messaging system.")))
 166
 167 (defvar nnrss-use-local nil)
 168
 169 (defvar nnrss-description-field 'X-Gnus-Description
 170   "Field name used for DESCRIPTION.
 171 To use the description in headers, put this name into `nnmail-extra-headers'.")
 172
 173 (defvar nnrss-url-field 'X-Gnus-Url
 174   "Field name used for URL.
 175 To use the description in headers, put this name into `nnmail-extra-headers'.")
 176
 177 (nnoo-define-basics nnrss)
 178
 179 ;;; Interface functions
 180
 181 (deffoo nnrss-retrieve-headers (articles &optional group server fetch-old)
 182   (nnrss-possibly-change-group group server)
 183   (let (e)
 184     (save-excursion
 185       (set-buffer nntp-server-buffer)
 186       (erase-buffer)
 187       (dolist (article articles)
 188         (if (setq e (assq article nnrss-group-data))
 189             (insert (number-to-string (car e)) "\t" ;; number
 190                     (if (nth 3 e)
 191                         (nnrss-format-string (nth 3 e)) "")
 192                     "\t" ;; subject
 193                     (if (nth 4 e)
 194                         (nnrss-format-string (nth 4 e))
 195                       "(nobody)")
 196                     "\t" ;;from
 197                     (or (nth 5 e) "")
 198                     "\t" ;; date
 199                     (format "<%d@%s.nnrss>" (car e) group)
 200                     "\t" ;; id
 201                     "\t" ;; refs
 202                     "-1" "\t" ;; chars
 203                     "-1" "\t" ;; lines
 204                     "" "\t" ;; Xref
 205                     (if (and (nth 6 e)
 206                              (memq nnrss-description-field
 207                                    nnmail-extra-headers))
 208                         (concat (symbol-name nnrss-description-field)
 209                                 ": "
 210                                 (nnrss-format-string (nth 6 e))
 211                                 "\t")
 212                       "")
 213                     (if (and (nth 2 e)
 214                              (memq nnrss-url-field
 215                                    nnmail-extra-headers))
 216                         (concat (symbol-name nnrss-url-field)
 217                                 ": "
 218                                 (nnrss-format-string (nth 2 e))
 219                                 "\t")
 220                       "")
 221                     "\n")))))
 222   'nov)
 223
 224 (deffoo nnrss-request-group (group &optional server dont-check)
 225   (nnrss-possibly-change-group group server)
 226   (if dont-check
 227       t
 228     (nnrss-check-group group server)
 229     (nnheader-report 'nnrss "Opened group %s" group)
 230     (nnheader-insert
 231      "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max
 232      (prin1-to-string group)
 233      t)))
 234
 235 (deffoo nnrss-close-group (group &optional server)
 236   t)
 237
 238 (deffoo nnrss-request-article (article &optional group server buffer)
 239   (nnrss-possibly-change-group group server)
 240   (let ((e (assq article nnrss-group-data))
 241         (nntp-server-buffer (or buffer nntp-server-buffer))
 242         post err)
 243     (when e
 244       (catch 'error
 245         (with-current-buffer nntp-server-buffer
 246           (erase-buffer)
 247           (goto-char (point-min))
 248           (if group
 249               (insert "Newsgroups: " group "\n"))
 250           (if (nth 3 e)
 251               (insert "Subject: " (nnrss-format-string (nth 3 e)) "\n"))
 252           (if (nth 4 e)
 253               (insert "From: " (nnrss-format-string (nth 4 e)) "\n"))
 254           (if (nth 5 e)
 255               (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
 256           (insert "Message-ID: " (format "<%d@%s.nnrss>" (car e) group) "\n")
 257           (insert "\n")
 258           (if (nth 6 e)
 259               (let ((point (point)))
 260                 (insert (nnrss-string-as-multibyte (nth 6 e)))
 261                 (goto-char point)
 262                 (while (search-forward "\n" nil t)
 263                   (delete-char -1))
 264                 (goto-char (point-max))
 265                 (insert "\n\n")
 266                 (fill-region point (point))))
 267           (if (nth 2 e)
 268               (insert (nth 2 e) "\n")))))
 269     (cond
 270      (err
 271       (nnheader-report 'nnrss err))
 272      ((not e)
 273       (nnheader-report 'nnrss "No such id: %d" article))
 274      (t
 275       (nnheader-report 'nnrss "Article %s retrieved" (car e))
 276       ;; We return the article number.
 277       (cons nnrss-group (car e))))))