X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnrss.el;h=8f66d431ed899ec3f4a40352e54a8d0f374670be;hb=80da5d5be490f308f36327b705fc28cba15dd2d0;hp=e8f3332c21c569843106826508a60a9f3b030abb;hpb=12880262125c73b531b08cd9005fbaf49c2c3395;p=elisp%2Fgnus.git- diff --git a/lisp/nnrss.el b/lisp/nnrss.el index e8f3332..8f66d43 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -1,5 +1,5 @@ ;;; nnrss.el --- interfacing with RSS -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: RSS @@ -27,24 +27,19 @@ (eval-when-compile (require 'cl)) +(require 'gnus) (require 'nnoo) (require 'nnmail) (require 'message) (require 'mm-util) (require 'gnus-util) (require 'time-date) +(require 'rfc2231) +(require 'mm-url) (eval-when-compile (ignore-errors - (require 'xml) - (require 'w3) - (require 'w3-forms) - (require 'nnweb))) -;; Report failure to find w3 at load time if appropriate. -(eval '(progn - (require 'xml) - (require 'w3) - (require 'w3-forms) - (require 'nnweb))) + (require 'xml))) +(eval '(require 'xml)) (nnoo-declare nnrss) @@ -66,7 +61,8 @@ (defvar nnrss-group-alist '(("MacWeek" - "http://macweek.zdnet.com/macweek.xml") + "http://macweek.zdnet.com/macweek.xml" + "The Macintosh news authority.") ("Linux.Weekly.News" "http://lwn.net/headlines/rss") ("Motley.Fool" @@ -76,17 +72,22 @@ ("Slashdot" "http://www.slashdot.com/slashdot.rdf") ("CNN" - "http://www.cnn.com/cnn.rss") + "http://www.cnn.com/cnn.rss" + "The world's news leader.") ("FreshMeat" - "http://freshmeat.net/backend/fm.rdf") + "http://freshmeat.net/backend/fm-releases.rdf" + "The one-stop-shop for all your Linux software needs.") ("The.Guardian.newspaper" - "http://www.guardianunlimited.co.uk/rss/1,,,00.xml") + "http://www.guardianunlimited.co.uk/rss/1,,,00.xml" + "Intelligent news and comment throughout the day from The Guardian newspaper.") ("MonkeyFist.rdf" - "http://monkeyfist.com/rdf.php3") + "http://monkeyfist.com/rdf.php3" + "News and opinion on politics, technology, and eclectic miscellany.") ("NewsForge" "http://www.newsforge.com/newsforge.rss") ("Reuters.Health" - "http://www.reutershealth.com/eline.rss") + "http://www.reutershealth.com/eline.rss" + "Consumer-oriented health-related news stories.") ("Salon" "http://www.salon.com/feed/RDF/salon_use.rdf") ("Wired" @@ -94,14 +95,90 @@ ("ITN" "http://www.itn.co.uk/itn.rdf") ("Meerkat" - "http://www.oreillynet.com/meerkat/?_fl=rss10") + "http://www.oreillynet.com/meerkat/?_fl=rss10" + "An Open Wire Service") ("MonkeyFist" - "http://monkeyfist.com/rss1.php3") + "http://monkeyfist.com/rss1.php3" + "News and opinion on politics, technology, and eclectic miscellany.") ("Reuters.Health.rdf" - "http://www.reutershealth.com/eline.rdf"))) + "http://www.reutershealth.com/eline.rdf" + "Consumer-oriented health-related news stories.") + ;;("4xt" "http://4xt.org/news/general.rss10" "Resources for XT users.") + ("Aaronland" "http://aaronland.net/xml/abhb.rdf" "A boy and his basement.") + ("Art of the Mix" "http://www.artofthemix.org/xml/rss.asp" "A website devoted to the art of making mixed tapes and cds.") + ("Dave Beckett's RDF Resource Guide" "http://www.ilrt.bristol.ac.uk/discovery/rdf/resources/rss.rdf" "A comprehensive guide to resources about RDF.") + ("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.") + ;;("Dublin Core Metadata Intitiative" "http://www.dublincore.org/news.rss" "Latest news from DCMI.") + ("Figby Articles" "http://www.figby.com/index-rss.php" "A weblog with daily stories about technology, books and publishing, privacy, science, and occasional humor.") + ;;("Figby News" "http://www.figby.com/news.php" "Categorized RSS feeds from various sources.") + ("Figby Quickies" "http://www.figby.com/quickies-rss.php" "Quick commented links to other sites from Figby.com.") + ("Flutterby!" "http://www.flutterby.com/main.rdf" "News and views from Dan Lyke.") + ("Groovelog" "http://groovelog.agora.co.uk/groove+log/groovelog.nsf/today.rss.xml" "The open-access groove users' weblog.") + ;;("Groovelog.rss10" "http://groovelog.agora.co.uk/groove+log/groovelog.nsf/today.rss10.xml" "The open-access groove users' weblog.") + ("Hit or Miss" "http://hit-or-miss.org/rss/" "Daily weblog and journal.") + ;;("Internet.com Feeds" "http://www.webreference.com/services/news/" "News from ") + ("Larkfarm News" "http://www.larkfarm.com/Larkfarm.rdf" "Mike Gunderloy's web site.") + ("Latest RFCs" "http://x42.com/rss/rfc.rss") + ("Linux Today" "http://linuxtoday.com/backend/biglt.rss") + ("Linux Today.rdf" "http://linuxtoday.com/backend/my-netscape10.rdf") + ("More Like This WebLog" "http://www.whump.com/moreLikeThis/RSS" "Because the more you know, the more jokes you get.") + ("Motivational Quotes of the Day" "http://www.quotationspage.com/data/mqotd.rss" "Four motivational quotations each day from the Quotations Page.") + ;;("My Netscape Network" "http://www.dmoz.org/Netscape/My_Netscape_Network/") + ;;("My UserLand" "http://my.userland.com/choose") + ("Network World Fusion NetFlash" "http://www.nwfusion.com/netflash.rss" "Daily breaking news about networking products, technologies and services.") + ;;("News Feeds" "http://newsfeeds.manilasites.com/" "Jeff Barr highlights high quality RSS feeds.") + ;;("News Is Free Export" "http://www.newsisfree.com/export.php3") + ("News Is Free" "http://www.newsisfree.com/news.rdf.php3") + ;;("News is Free XML Export" "http://www.newsisfree.com/ocs/directory.xml") + ("O'Reilly Network Articles" "http://www.oreillynet.com/cs/rss/query/q/260?x-ver=1.0") + ("Quotes of the Day" "http://www.quotationspage.com/data/qotd.rss" "Four humorous quotations each day from the Quotations Page.") + ("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.") + ("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.") + ("RSS Info" "http://www.blogspace.com/rss/rss10" "News and information on the RSS format") + ;;("RSS-DEV listing" "http://www.egroups.com/links/rss-dev/Feeds_000966335046/" "A listing of RSS files from the RSS-DEV list.") + ("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.") + ;;("Sherch!" "http://www.sherch.com/~pldms/cgi-bin/sherch.pl" "Sherlock for the rest of us.") + ;;("Street Fusion Archived Financial Webcasts" "http://partners.streetfusion.com/rdf/archive.rdf") + ;;("Street Fusion Upcoming Financial Webcasts" "http://partners.streetfusion.com/rdf/live.rdf") + ;;("TNL.net newsletter" "http://www.tnl.net/newsletter/channel100.asp" "A newsletter about Internet technology and issues.") + ("W3C" "http://www.w3.org/2000/08/w3c-synd/home.rss" "The latest news at the World Wide Web Consortium.") + ;;("XML News: RSS Live Content" "http://www.xmlnews.org/RSS/content.html" "A listing of well-known RSS feeds.") + ("|fr| XMLfr" "http://xmlfr.org/actualites/general.rss10" + "French speaking portal site dedicated to XML.") + ("XMLhack" "http://xmlhack.com/rss10.php" + "Developer news from the XML community.") + ("The Register" + "http://www.theregister.co.uk/tonys/slashdot.rdf" + "The Register -- Biting the hand that feeds IT.") + ("|de| Heise-Ticker" + "http://www.heise.de/newsticker/heise.rdf" + "German news ticker about technology.") + ("|de| Telepolis News" + "http://www.heise.de/tp/news.rdf" + "German background news about technology.") + ("Kuro5hin" + "http://www.kuro5hin.org/backend.rdf" + "Technology and culture, from the trenches.") + ("JabberCentral" + "http://www.jabbercentral.com/rss.php" + "News around the Jabber instant messaging system."))) (defvar nnrss-use-local nil) +(defvar nnrss-description-field 'X-Gnus-Description + "Field name used for DESCRIPTION. +To use the description in headers, put this name into `nnmail-extra-headers'.") + +(defvar nnrss-url-field 'X-Gnus-Url + "Field name used for URL. +To use the description in headers, put this name into `nnmail-extra-headers'.") + +(defvar nnrss-content-function nil + "A function which is called in `nnrss-request-article'. +The arguments are (ENTRY GROUP ARTICLE). +ENTRY is the record of the current headline. GROUP is the group name. +ARTICLE is the article number of the current headline.") + (nnoo-define-basics nnrss) ;;; Interface functions @@ -116,18 +193,36 @@ (if (setq e (assq article nnrss-group-data)) (insert (number-to-string (car e)) "\t" ;; number (if (nth 3 e) - (nnrss-string-as-multibyte (nth 3 e)) "") + (nnrss-format-string (nth 3 e)) "") "\t" ;; subject (if (nth 4 e) - (nnrss-string-as-multibyte (nth 4 e)) "") + (nnrss-format-string (nth 4 e)) + "(nobody)") "\t" ;;from (or (nth 5 e) "") "\t" ;; date (format "<%d@%s.nnrss>" (car e) group) "\t" ;; id "\t" ;; refs - "0" "\t" ;; chars - "0" "\t" ;; lines + "-1" "\t" ;; chars + "-1" "\t" ;; lines + "" "\t" ;; Xref + (if (and (nth 6 e) + (memq nnrss-description-field + nnmail-extra-headers)) + (concat (symbol-name nnrss-description-field) + ": " + (nnrss-format-string (nth 6 e)) + "\t") + "") + (if (and (nth 2 e) + (memq nnrss-url-field + nnmail-extra-headers)) + (concat (symbol-name nnrss-url-field) + ": " + (nnrss-format-string (nth 2 e)) + "\t") + "") "\n"))))) 'nov) @@ -155,20 +250,29 @@ (with-current-buffer nntp-server-buffer (erase-buffer) (goto-char (point-min)) + (if group + (insert "Newsgroups: " group "\n")) (if (nth 3 e) - (insert "Subject: " (nnrss-string-as-multibyte (nth 3 e)) "\n")) + (insert "Subject: " (nnrss-format-string (nth 3 e)) "\n")) (if (nth 4 e) - (insert "From: " (nnrss-string-as-multibyte (nth 4 e)) "\n")) + (insert "From: " (nnrss-format-string (nth 4 e)) "\n")) (if (nth 5 e) - (insert "Date: " (nnrss-string-as-multibyte (nth 5 e)) "\n")) + (insert "Date: " (nnrss-format-string (nth 5 e)) "\n")) (insert "Message-ID: " (format "<%d@%s.nnrss>" (car e) group) "\n") (insert "\n") (if (nth 6 e) (let ((point (point))) - (insert (nnrss-string-as-multibyte (nth 6 e)) "\n\n") + (insert (nnrss-string-as-multibyte (nth 6 e))) + (goto-char point) + (while (search-forward "\n" nil t) + (delete-char -1)) + (goto-char (point-max)) + (insert "\n\n") (fill-region point (point)))) (if (nth 2 e) - (insert (nth 2 e) "\n"))))) + (insert (nth 2 e) "\n")) + (if nnrss-content-function + (funcall nnrss-content-function e group article))))) (cond (err (nnheader-report 'nnrss err)) @@ -185,34 +289,51 @@ t) (deffoo nnrss-open-server (server &optional defs connectionless) + (nnrss-read-server-data server) (nnoo-change-server 'nnrss server defs) t) (deffoo nnrss-request-expire-articles (articles group &optional server force) (nnrss-possibly-change-group group server) - (let (e changed days) + (let (e days not-expirable changed) (dolist (art articles) - (when (setq e (assq art nnrss-group-data)) - (if (nnmail-expired-article-p - group - (if (listp (setq days (nth 1 e))) days (days-to-time days)) - force) + (if (and (setq e (assq art nnrss-group-data)) + (nnmail-expired-article-p + group + (if (listp (setq days (nth 1 e))) days + (days-to-time (- days (time-to-days '(0 0))))) + force)) (setq nnrss-group-data (delq e nnrss-group-data) - changed t)))) + changed t) + (push art not-expirable))) (if changed - (nnrss-save-group-data group server)))) + (nnrss-save-group-data group server)) + not-expirable)) (deffoo nnrss-request-delete-group (group &optional force server) (nnrss-possibly-change-group group server) (setq nnrss-server-data (delq (assoc group nnrss-server-data) nnrss-server-data)) (nnrss-save-server-data server) - (let ((file (expand-file-name (concat group (and server - (not (equal server "")) - "-") - server ".el") nnrss-directory))) - (delete-file file)) + (let ((file (expand-file-name + (nnrss-translate-file-chars + (concat group (and server + (not (equal server "")) + "-") + server ".el")) nnrss-directory))) + (ignore-errors + (delete-file file))) + t) + +(deffoo nnrss-request-list-newsgroups (&optional server) + (nnrss-possibly-change-group nil server) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (dolist (elem nnrss-group-alist) + (if (third elem) + (insert (car elem) "\t" (third elem) "\n")))) t) (nnoo-define-skeleton nnrss) @@ -222,13 +343,17 @@ (defun nnrss-possibly-change-group (&optional group server) (when (and server (not (nnrss-server-opened server))) - (nnrss-read-server-data server) (nnrss-open-server server)) (when (and group (not (equal group nnrss-group))) (nnrss-read-group-data group server) (setq nnrss-group group))) +(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories)) + (defun nnrss-generate-active () + (if (y-or-n-p "Fetch extra categories? ") + (dolist (func nnrss-extra-categories) + (funcall func))) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) @@ -242,27 +367,36 @@ (defun nnrss-read-server-data (server) (setq nnrss-server-data nil) - (let ((file (expand-file-name (concat "nnrss" (and server - (not (equal server "")) - "-") - server - ".el") - nnrss-directory))) + (let ((file (expand-file-name + (nnrss-translate-file-chars + (concat "nnrss" (and server + (not (equal server "")) + "-") + server + ".el")) + nnrss-directory))) (when (file-exists-p file) (with-temp-buffer - (let ((coding-system-for-read 'binary)) - (insert-file-contents file)) - (goto-char (point-min)) - (eval-buffer))))) + (let ((coding-system-for-read 'binary) + (input-coding-system 'binary) + emacs-lisp-mode-hook) + (insert-file-contents file) + (emacs-lisp-mode) + (goto-char (point-min)) + (eval-buffer)))))) (defun nnrss-save-server-data (server) (gnus-make-directory nnrss-directory) - (let ((file (expand-file-name (concat "nnrss" (and server - (not (equal server "")) - "-") - server ".el") - nnrss-directory))) - (let ((coding-system-for-write 'binary)) + (let ((file (expand-file-name + (nnrss-translate-file-chars + (concat "nnrss" (and server + (not (equal server "")) + "-") + server ".el")) + nnrss-directory))) + (let ((coding-system-for-write 'binary) + (output-coding-system 'binary) + print-level print-length) (with-temp-file file (insert "(setq nnrss-server-data '" (prin1-to-string nnrss-server-data) @@ -274,17 +408,22 @@ (let ((pair (assoc group nnrss-server-data))) (setq nnrss-group-max (or (cadr pair) 0)) (setq nnrss-group-min (+ nnrss-group-max 1))) - (let ((file (expand-file-name (concat group (and server - (not (equal server "")) - "-") - server ".el") - nnrss-directory))) + (let ((file (expand-file-name + (nnrss-translate-file-chars + (concat group (and server + (not (equal server "")) + "-") + server ".el")) + nnrss-directory))) (when (file-exists-p file) (with-temp-buffer - (let ((coding-system-for-read 'binary)) - (insert-file-contents file)) - (goto-char (point-min)) - (eval-buffer)) + (let ((coding-system-for-read 'binary) + (input-coding-system 'binary) + emacs-lisp-mode-hook) + (insert-file-contents file) + (emacs-lisp-mode) + (goto-char (point-min)) + (eval-buffer))) (dolist (e nnrss-group-data) (gnus-sethash (nth 2 e) e nnrss-group-hashtb) (if (and (car e) (> nnrss-group-min (car e))) @@ -294,12 +433,16 @@ (defun nnrss-save-group-data (group server) (gnus-make-directory nnrss-directory) - (let ((file (expand-file-name (concat group (and server - (not (equal server "")) - "-") - server ".el") - nnrss-directory))) - (let ((coding-system-for-write 'binary)) + (let ((file (expand-file-name + (nnrss-translate-file-chars + (concat group (and server + (not (equal server "")) + "-") + server ".el")) + nnrss-directory))) + (let ((coding-system-for-write 'binary) + (output-coding-system 'binary) + print-level print-length) (with-temp-file file (insert "(setq nnrss-group-data '" (prin1-to-string nnrss-group-data) @@ -311,16 +454,13 @@ "") (defun nnrss-insert-w3 (url) - (require 'url) - (require 'url-cache) - (let ((url-cache-creation-function 'nnrss-no-cache)) - (mm-with-unibyte-current-buffer - (nnweb-insert url)))) + (mm-with-unibyte-current-buffer + (mm-url-insert url))) (defun nnrss-decode-entities-unibyte-string (string) (mm-with-unibyte-buffer (insert string) - (nnweb-decode-entities) + (mm-url-decode-entities-nbsp) (buffer-substring (point-min) (point-max)))) (defalias 'nnrss-insert 'nnrss-insert-w3) @@ -332,66 +472,124 @@ ;;; Snarf functions (defun nnrss-check-group (group server) - (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)) - file xml subject url extra changed author date) - (mm-with-unibyte-buffer - (if (and nnrss-use-local - (file-exists-p (setq file (expand-file-name - (concat group ".xml") - nnrss-directory)))) - (insert-file-contents file) - (setq url (or (nth 2 (assoc group nnrss-server-data)) - (second (assoc group nnrss-group-alist)))) - (unless url - (setq url - (read-string (format "RSS url of %s: " group "http://"))) - (let ((pair (assoc group nnrss-server-data))) - (if pair - (setcdr (cdr pair) (list url)) - (push (list group nnrss-group-max url) nnrss-server-data))) - (setq changed t)) - (nnrss-insert url)) - (goto-char (point-min)) - (while (re-search-forward "\r\n?" nil t) - (replace-match "\n")) - (goto-char (point-min)) - (if (re-search-forward "\\|