X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnrss.el;h=1ffff53347ba597e9773d6de8b8ee5eafbdf2c89;hb=d6fc071ac11d2854744bfb90c3f9b2aff3466579;hp=aad8fcc1fa3114469141953b6c337a905fee0123;hpb=ff5468187ac7f6697e9951916082c56dd7829ab1;p=gnus diff --git a/lisp/nnrss.el b/lisp/nnrss.el index aad8fcc1f..1ffff5334 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -27,6 +27,7 @@ (eval-when-compile (require 'cl)) +(require 'gnus) (require 'nnoo) (require 'nnmail) (require 'message) @@ -34,18 +35,12 @@ (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))) + (require 'xml))) ;; Report failure to find w3 at load time if appropriate. -(eval '(progn - (require 'xml) - (require 'w3) - (require 'w3-forms) - (require 'nnweb))) +(eval '(require 'xml)) (nnoo-declare nnrss) @@ -81,7 +76,7 @@ "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" @@ -109,51 +104,76 @@ ("Reuters.Health.rdf" "http://www.reutershealth.com/eline.rdf" "Consumer-oriented health-related news stories.") - ;;("4xt" "http://4xt.org/news/general.rss10" "Resources for XT users.") +;;("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.") +;;("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 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.") +;;("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 ") +;;("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 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 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") +;;("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.") +;;("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.") +;;("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.") - ("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."))) +;;("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'.") + (nnoo-define-basics nnrss) ;;; Interface functions @@ -172,15 +192,32 @@ "\t" ;; subject (if (nth 4 e) (nnrss-format-string (nth 4 e)) - "(nobody)") + "(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) @@ -208,18 +245,24 @@ (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-format-string (nth 3 e)) "\n")) - (insert "From: " (if (nth 4 e) - (nnrss-format-string (nth 4 e)) - "(nobody)" "\n")) + (if (nth 4 e) + (insert "From: " (nnrss-format-string (nth 4 e)) "\n")) (if (nth 5 e) (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"))))) @@ -251,7 +294,7 @@ (if (and (setq e (assq art nnrss-group-data)) (nnmail-expired-article-p group - (if (listp (setq days (nth 1 e))) days + (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) @@ -266,7 +309,7 @@ (setq nnrss-server-data (delq (assoc group nnrss-server-data) nnrss-server-data)) (nnrss-save-server-data server) - (let ((file (expand-file-name + (let ((file (expand-file-name (nnrss-translate-file-chars (concat group (and server (not (equal server "")) @@ -301,7 +344,7 @@ (defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories)) (defun nnrss-generate-active () - (if (y-or-n-p "Fetch extra categories?") + (if (y-or-n-p "Fetch extra categories? ") (dolist (func nnrss-extra-categories) (funcall func))) (save-excursion @@ -317,7 +360,7 @@ (defun nnrss-read-server-data (server) (setq nnrss-server-data nil) - (let ((file (expand-file-name + (let ((file (expand-file-name (nnrss-translate-file-chars (concat "nnrss" (and server (not (equal server "")) @@ -327,22 +370,24 @@ nnrss-directory))) (when (file-exists-p file) (with-temp-buffer - (let ((coding-system-for-read 'binary)) - (insert-file-contents file)) - (emacs-lisp-mode) - (goto-char (point-min)) - (eval-buffer))))) + (let ((coding-system-for-read '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 + (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)) + (let ((coding-system-for-write 'binary) + print-level print-length) (with-temp-file file (insert "(setq nnrss-server-data '" (prin1-to-string nnrss-server-data) @@ -354,7 +399,7 @@ (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 + (let ((file (expand-file-name (nnrss-translate-file-chars (concat group (and server (not (equal server "")) @@ -363,11 +408,12 @@ nnrss-directory))) (when (file-exists-p file) (with-temp-buffer - (let ((coding-system-for-read 'binary)) - (insert-file-contents file)) - (emacs-lisp-mode) - (goto-char (point-min)) - (eval-buffer)) + (let ((coding-system-for-read '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))) @@ -377,14 +423,15 @@ (defun nnrss-save-group-data (group server) (gnus-make-directory nnrss-directory) - (let ((file (expand-file-name + (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)) + (let ((coding-system-for-write 'binary) + print-level print-length) (with-temp-file file (insert "(setq nnrss-group-data '" (prin1-to-string nnrss-group-data) @@ -395,23 +442,14 @@ (defun nnrss-no-cache (url) "") -;; TODO:: disable cache. -;; -;; (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)))) - (defun nnrss-insert-w3 (url) (mm-with-unibyte-current-buffer - (nnweb-insert url))) + (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) @@ -423,21 +461,20 @@ ;;; 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) + (let (file xml subject url extra changed author date) (condition-case err (mm-with-unibyte-buffer (if (and nnrss-use-local (file-exists-p (setq file (expand-file-name - (nnrss-translate-file-chars - (concat group ".xml")) - nnrss-directory)))) + (nnrss-translate-file-chars + (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://"))) + (read-string (format "RSS url of %s: " group "http://"))) (let ((pair (assoc group nnrss-server-data))) (if pair (setcdr (cdr pair) (list url)) @@ -451,35 +488,36 @@ (if (re-search-forward "\\|