diff options
Diffstat (limited to 'lisp/gnus/nnrss.el')
| -rw-r--r-- | lisp/gnus/nnrss.el | 771 |
1 files changed, 771 insertions, 0 deletions
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el new file mode 100644 index 0000000000..9b4825c53f --- /dev/null +++ b/lisp/gnus/nnrss.el @@ -0,0 +1,771 @@ +;;; nnrss.el --- interfacing with RSS +;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. + +;; Author: Shenghuo Zhu <[email protected]> +;; Keywords: RSS + +;; 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 2, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(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))) +(eval '(require 'xml)) + +(nnoo-declare nnrss) + +(defvoo nnrss-directory (nnheader-concat gnus-directory "rss/") + "Where nnrss will save its files.") + +;; (group max rss-url) +(defvoo nnrss-server-data nil) + +;; (num timestamp url subject author date extra) +(defvoo nnrss-group-data nil) +(defvoo nnrss-group-max 0) +(defvoo nnrss-group-min 1) +(defvoo nnrss-group nil) +(defvoo nnrss-group-hashtb nil) +(defvoo nnrss-status-string "") + +(defconst nnrss-version "nnrss 1.0") + +(defvar nnrss-group-alist '() + "List of RSS addresses.") + +(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 + +(deffoo nnrss-retrieve-headers (articles &optional group server fetch-old) + (nnrss-possibly-change-group group server) + (let (e) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (dolist (article articles) + (if (setq e (assq article nnrss-group-data)) + (insert (number-to-string (car e)) "\t" ;; number + (if (nth 3 e) + (nnrss-format-string (nth 3 e)) "") + "\t" ;; subject + (if (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 + "-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) + +(deffoo nnrss-request-group (group &optional server dont-check) + (nnrss-possibly-change-group group server) + (if dont-check + t + (nnrss-check-group group server) + (nnheader-report 'nnrss "Opened group %s" group) + (nnheader-insert + "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max + (prin1-to-string group) + t))) + +(deffoo nnrss-close-group (group &optional server) + t) + +(deffoo nnrss-request-article (article &optional group server buffer) + (nnrss-possibly-change-group group server) + (let ((e (assq article nnrss-group-data)) + (boundary "=-=-=-=-=-=-=-=-=-") + (nntp-server-buffer (or buffer nntp-server-buffer)) + post err) + (when e + (catch 'error + (with-current-buffer nntp-server-buffer + (erase-buffer) + (goto-char (point-min)) + (insert "Mime-Version: 1.0\nContent-Type: multipart/alternative; boundary=\"" boundary "\"\n") + (if group + (insert "Newsgroups: " group "\n")) + (if (nth 3 e) + (insert "Subject: " (nnrss-format-string (nth 3 e)) "\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") + (let ((text (if (nth 6 e) + (nnrss-string-as-multibyte (nth 6 e)))) + (link (if (nth 2 e) + (nth 2 e)))) + (insert "\n\n--" boundary "\nContent-Type: text/plain\n\n") + (let ((point (point))) + (if text + (progn (insert text) + (goto-char point) + (while (re-search-forward "\n" nil t) + (replace-match " ")) + (goto-char (point-max)) + (insert "\n\n"))) + (if link + (insert link))) + (insert "\n\n--" boundary "\nContent-Type: text/html\n\n") + (let ((point (point))) + (if text + (progn (insert "<html><head></head><body>\n" text "\n</body></html>") + (goto-char point) + (while (re-search-forward "\n" nil t) + (replace-match " ")) + (goto-char (point-max)) + (insert "\n\n"))) + (if link + (insert "<p><a href=\"" link "\">link</a></p>\n")))) + (if nnrss-content-function + (funcall nnrss-content-function e group article))))) + (cond + (err + (nnheader-report 'nnrss err)) + ((not e) + (nnheader-report 'nnrss "no such id: %d" article)) + (t + (nnheader-report 'nnrss "article %s retrieved" (car e)) + ;; we return the article number. + (cons nnrss-group (car e)))))) + +(deffoo nnrss-request-list (&optional server) + (nnrss-possibly-change-group nil server) + (nnrss-generate-active) + 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 days not-expirable changed) + (dolist (art articles) + (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) + (push art not-expirable))) + (if changed + (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 + (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) + +;;; Internal functions +(eval-when-compile (defun xml-rpc-method-call (&rest args))) +(defun nnrss-fetch (url &optional local) + "Fetch the url and put it in a the expected lisp structure." + (with-temp-buffer + ;some CVS versions of url.el need this to close the connection quickly + (let* (xmlform htmlform) + ;; bit o' work necessary for w3 pre-cvs and post-cvs + (if local + (let ((coding-system-for-read 'binary)) + (insert-file-contents url)) + (mm-url-insert url)) + +;; Because xml-parse-region can't deal with anything that isn't +;; xml and w3-parse-buffer can't deal with some xml, we have to +;; parse with xml-parse-region first and, if that fails, parse +;; with w3-parse-buffer. Yuck. Eventually, someone should find out +;; why w3-parse-buffer fails to parse some well-formed xml and +;; fix it. + + (condition-case err + (setq xmlform (xml-parse-region (point-min) (point-max))) + (error (if (fboundp 'w3-parse-buffer) + (setq htmlform (caddar (w3-parse-buffer + (current-buffer)))) + (message "nnrss: Not valid XML and w3 parse not available (%s)" + url)))) + (if htmlform + htmlform + xmlform)))) + +(defun nnrss-possibly-change-group (&optional group server) + (when (and server + (not (nnrss-server-opened 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) + (dolist (elem nnrss-group-alist) + (insert (prin1-to-string (car elem)) " 0 1 y\n")) + (dolist (elem nnrss-server-data) + (unless (assoc (car elem) nnrss-group-alist) + (insert (prin1-to-string (car elem)) " 0 1 y\n"))))) + +;;; data functions + +(defun nnrss-read-server-data (server) + (setq nnrss-server-data nil) + (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) + 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 + (nnrss-translate-file-chars + (concat "nnrss" (and server + (not (equal server "")) + "-") + server ".el")) + nnrss-directory))) + (let ((coding-system-for-write 'binary) + print-level print-length) + (with-temp-file file + (insert "(setq nnrss-group-alist '" + (prin1-to-string nnrss-group-alist) + ")\n") + (insert "(setq nnrss-server-data '" + (prin1-to-string nnrss-server-data) + ")\n"))))) + +(defun nnrss-read-group-data (group server) + (setq nnrss-group-data nil) + (setq nnrss-group-hashtb (gnus-make-hashtable)) + (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 + (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) + 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))) + (setq nnrss-group-min (car e))) + (if (and (car e) (< nnrss-group-max (car e))) + (setq nnrss-group-max (car e))))))) + +(defun nnrss-save-group-data (group server) + (gnus-make-directory nnrss-directory) + (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) + print-level print-length) + (with-temp-file file + (insert "(setq nnrss-group-data '" + (prin1-to-string nnrss-group-data) + ")\n"))))) + +;;; URL interface + +(defun nnrss-no-cache (url) + "") + +(defun nnrss-insert-w3 (url) + (mm-with-unibyte-current-buffer + (mm-url-insert url))) + +(defun nnrss-decode-entities-unibyte-string (string) + (if string + (mm-with-unibyte-buffer + (insert string) + (mm-url-decode-entities-nbsp) + (buffer-string)))) + +(defalias 'nnrss-insert 'nnrss-insert-w3) + +(if (featurep 'xemacs) + (defalias 'nnrss-string-as-multibyte 'identity) + (defalias 'nnrss-string-as-multibyte 'string-as-multibyte)) + +;;; Snarf functions + +(defun nnrss-check-group (group server) + (let (file xml subject url extra changed author + date rss-ns rdf-ns content-ns dc-ns) + (if (and nnrss-use-local + (file-exists-p (setq file (expand-file-name + (nnrss-translate-file-chars + (concat group ".xml")) + nnrss-directory)))) + (setq xml (nnrss-fetch file t)) + (setq url (or (nth 2 (assoc group nnrss-server-data)) + (second (assoc group nnrss-group-alist)))) + (unless url + (setq url + (cdr + (assoc 'href + (nnrss-discover-feed + (read-string + (format "URL to search for %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)) + (setq xml (nnrss-fetch url))) + ;; See + ;; http://feeds.archive.org/validator/docs/howto/declare_namespaces.html + ;; for more RSS namespaces. + (setq dc-ns (nnrss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/") + rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#") + rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/") + content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/")) + (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml))) + (when (and (listp item) + (eq (intern (concat rss-ns "item")) (car item)) + (setq url (nnrss-decode-entities-unibyte-string + (nnrss-node-text rss-ns 'link (cddr item)))) + (not (gnus-gethash url nnrss-group-hashtb))) + (setq subject (nnrss-node-text rss-ns 'title item)) + (setq extra (or (nnrss-node-text content-ns 'encoded item) + (nnrss-node-text rss-ns 'description item))) + (setq author (or (nnrss-node-text rss-ns 'author item) + (nnrss-node-text dc-ns 'creator item) + (nnrss-node-text dc-ns 'contributor item))) + (setq date (or (nnrss-node-text dc-ns 'date item) + (nnrss-node-text rss-ns 'pubDate item) + (message-make-date))) + (push + (list + (incf nnrss-group-max) + (current-time) + url + (and subject (nnrss-decode-entities-unibyte-string subject)) + (and author (nnrss-decode-entities-unibyte-string author)) + date + (and extra (nnrss-decode-entities-unibyte-string extra))) + nnrss-group-data) + (gnus-sethash url (car nnrss-group-data) nnrss-group-hashtb) + (setq changed t))) + (when changed + (nnrss-save-group-data group server) + (let ((pair (assoc group nnrss-server-data))) + (if pair + (setcar (cdr pair) nnrss-group-max) + (push (list group nnrss-group-max) nnrss-server-data))) + (nnrss-save-server-data server)))) + +(defun nnrss-generate-download-script () + "Generate a download script in the current buffer. +It is useful when `(setq nnrss-use-local t)'." + (interactive) + (insert "#!/bin/sh\n") + (insert "WGET=wget\n") + (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n") + (dolist (elem nnrss-server-data) + (let ((url (or (nth 2 elem) + (second (assoc (car elem) nnrss-group-alist))))) + (insert "$WGET -q -O \"$RSSDIR\"/'" + (nnrss-translate-file-chars (concat (car elem) ".xml")) + "' '" url "'\n")))) + +(defun nnrss-translate-file-chars (name) + (let ((nnheader-file-name-translation-alist + (append nnheader-file-name-translation-alist '((?' . ?_))))) + (nnheader-translate-file-chars name))) + +(defvar nnrss-moreover-url + "http://w.moreover.com/categories/category_list_rss.html" + "The url of moreover.com categories.") + +(defun nnrss-snarf-moreover-categories () + "Snarf RSS links from moreover.com." + (interactive) + (let (category name url changed) + (with-temp-buffer + (nnrss-insert nnrss-moreover-url) + (goto-char (point-min)) + (while (re-search-forward + "<a name=\"\\([^\"]+\\)\">\\|<a href=\"\\(http://[^\"]*moreover\\.com[^\"]+page\\?c=\\([^\"&]+\\)&o=rss\\)" nil t) + (if (match-string 1) + (setq category (match-string 1)) + (setq url (match-string 2) + name (mm-url-decode-entities-string + (rfc2231-decode-encoded-string + (match-string 3)))) + (if category + (setq name (concat category "." name))) + (unless (assoc name nnrss-server-data) + (setq changed t) + (push (list name 0 url) nnrss-server-data))))) + (if changed + (nnrss-save-server-data "")))) + +(defun nnrss-format-string (string) + (gnus-replace-in-string (nnrss-string-as-multibyte string) " *\n *" " ")) + +(defun nnrss-node-text (namespace local-name element) + (let* ((node (assq (intern (concat namespace (symbol-name local-name))) + element)) + (text (if (and node (listp node)) + (nnrss-node-just-text node) + node)) + (cleaned-text (if text (gnus-replace-in-string + text "^[\000-\037\177]+\\|^ +\\| +$" "")))) + (if (string-equal "" cleaned-text) + nil + cleaned-text))) + +(defun nnrss-node-just-text (node) + (if (and node (listp node)) + (mapconcat 'nnrss-node-just-text (cddr node) " ") + node)) + +(defun nnrss-find-el (tag data &optional found-list) + "Find the all matching elements in the data. Careful with this on +large documents!" + (if (listp data) + (mapcar (lambda (bit) + (if (car-safe bit) + (progn (if (equal tag (car bit)) + (setq found-list + (append found-list + (list bit)))) + (if (and (listp (car-safe (caddr bit))) + (not (stringp (caddr bit)))) + (setq found-list + (append found-list + (nnrss-find-el + tag (caddr bit)))) + (setq found-list + (append found-list + (nnrss-find-el + tag (cddr bit)))))))) + data)) + found-list) + +(defun nnrss-rsslink-p (el) + "Test if the element we are handed is an RSS autodiscovery link." + (and (eq (car-safe el) 'link) + (string-equal (cdr (assoc 'rel (cadr el))) "alternate") + (or (string-equal (cdr (assoc 'type (cadr el))) + "application/rss+xml") + (string-equal (cdr (assoc 'type (cadr el))) "text/xml")))) + +(defun nnrss-get-rsslinks (data) + "Extract the <link> elements that are links to RSS from the parsed data." + (delq nil (mapcar + (lambda (el) + (if (nnrss-rsslink-p el) el)) + (nnrss-find-el 'link data)))) + +(defun nnrss-extract-hrefs (data) + "Recursively extract hrefs from a page's source. DATA should be +the output of xml-parse-region or w3-parse-buffer." + (mapcar (lambda (ahref) + (cdr (assoc 'href (cadr ahref)))) + (nnrss-find-el 'a data))) + +(defmacro nnrss-match-macro (base-uri item + onsite-list offsite-list) + `(cond ((or (string-match (concat "^" ,base-uri) ,item) + (not (string-match "://" ,item))) + (setq ,onsite-list (append ,onsite-list (list ,item)))) + (t (setq ,offsite-list (append ,offsite-list (list ,item)))))) + +(defun nnrss-order-hrefs (base-uri hrefs) + "Given a list of hrefs, sort them using the following priorities: + 1. links ending in .rss + 2. links ending in .rdf + 3. links ending in .xml + 4. links containing the above + 5. offsite links + +BASE-URI is used to determine the location of the links and +whether they are `offsite' or `onsite'." + (let (rss-onsite-end rdf-onsite-end xml-onsite-end + rss-onsite-in rdf-onsite-in xml-onsite-in + rss-offsite-end rdf-offsite-end xml-offsite-end + rss-offsite-in rdf-offsite-in xml-offsite-in) + (mapcar (lambda (href) + (if (not (null href)) + (cond ((string-match "\\.rss$" href) + (nnrss-match-macro + base-uri href rss-onsite-end rss-offsite-end)) + ((string-match "\\.rdf$" href) + (nnrss-match-macro + base-uri href rdf-onsite-end rdf-offsite-end)) + ((string-match "\\.xml$" href) + (nnrss-match-macro + base-uri href xml-onsite-end xml-offsite-end)) + ((string-match "rss" href) + (nnrss-match-macro + base-uri href rss-onsite-in rss-offsite-in)) + ((string-match "rdf" href) + (nnrss-match-macro + base-uri href rdf-onsite-in rdf-offsite-in)) + ((string-match "xml" href) + (nnrss-match-macro + base-uri href xml-onsite-in xml-offsite-in))))) + hrefs) + (append + rss-onsite-end rdf-onsite-end xml-onsite-end + rss-onsite-in rdf-onsite-in xml-onsite-in + rss-offsite-end rdf-offsite-end xml-offsite-end + rss-offsite-in rdf-offsite-in xml-offsite-in))) + +(defun nnrss-discover-feed (url) + "Given a page, find an RSS feed using Mark Pilgrim's +`ultra-liberal rss locator' (http://diveintomark.org/2002/08/15.html)." + + (let ((parsed-page (nnrss-fetch url))) + +;; 1. if this url is the rss, use it. + (if (nnrss-rss-p parsed-page) + (let ((rss-ns (nnrss-get-namespace-prefix parsed-page "http://purl.org/rss/1.0/"))) + (nnrss-rss-title-description rss-ns parsed-page url)) + +;; 2. look for the <link rel="alternate" +;; type="application/rss+xml" and use that if it is there. + (let ((links (nnrss-get-rsslinks parsed-page))) + (if links + (let* ((xml (nnrss-fetch + (cdr (assoc 'href (cadar links))))) + (rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/"))) + (nnrss-rss-title-description rss-ns xml (cdr (assoc 'href (cadar links))))) + +;; 3. look for links on the site in the following order: +;; - onsite links ending in .rss, .rdf, or .xml +;; - onsite links containing any of the above +;; - offsite links ending in .rss, .rdf, or .xml +;; - offsite links containing any of the above + (let* ((base-uri (progn (string-match ".*://[^/]+/?" url) + (match-string 0 url))) + (hrefs (nnrss-order-hrefs + base-uri (nnrss-extract-hrefs parsed-page))) + (rss-link nil)) + (while (and (eq rss-link nil) (not (eq hrefs nil))) + (let ((href-data (nnrss-fetch (car hrefs)))) + (if (nnrss-rss-p href-data) + (let* ((rss-ns (nnrss-get-namespace-prefix href-data "http://purl.org/rss/1.0/"))) + (setq rss-link (nnrss-rss-title-description + rss-ns href-data (car hrefs)))) + (setq hrefs (cdr hrefs))))) + (if rss-link rss-link + +;; 4. check syndic8 + (nnrss-find-rss-via-syndic8 url)))))))) + +(defun nnrss-find-rss-via-syndic8 (url) + "query syndic8 for the rss feeds it has for the url." + (if (not (locate-library "xml-rpc")) + (progn + (message "XML-RPC is not available... not checking Syndic8.") + nil) + (require 'xml-rpc) + (let ((feedid (xml-rpc-method-call + "http://www.syndic8.com/xmlrpc.php" + 'syndic8.FindSites + url))) + (when feedid + (let* ((feedinfo (xml-rpc-method-call + "http://www.syndic8.com/xmlrpc.php" + 'syndic8.GetFeedInfo + feedid)) + (urllist + (delq nil + (mapcar + (lambda (listinfo) + (if (string-equal + (cdr (assoc "status" listinfo)) + "Syndicated") + (cons + (cdr (assoc "sitename" listinfo)) + (list + (cons 'title + (cdr (assoc + "sitename" listinfo))) + (cons 'href + (cdr (assoc + "dataurl" listinfo))))))) + feedinfo)))) + (if (not (> (length urllist) 1)) + (cdar urllist) + (let ((completion-ignore-case t) + (selection + (mapcar (lambda (listinfo) + (cons (cdr (assoc "sitename" listinfo)) + (string-to-int + (cdr (assoc "feedid" listinfo))))) + feedinfo))) + (cdr (assoc + (completing-read + "Multiple feeds found. Select one: " + selection nil t) urllist))))))))) + +(defun nnrss-rss-p (data) + "Test if data is an RSS feed. Simply ensures that the first +element is rss or rdf." + (or (eq (caar data) 'rss) + (eq (caar data) 'rdf:RDF))) + +(defun nnrss-rss-title-description (rss-namespace data url) + "Return the title of an RSS feed." + (if (nnrss-rss-p data) + (let ((description (intern (concat rss-namespace "description"))) + (title (intern (concat rss-namespace "title"))) + (channel (nnrss-find-el (intern (concat rss-namespace "channel")) + data))) + (list + (cons 'description (caddr (nth 0 (nnrss-find-el description channel)))) + (cons 'title (caddr (nth 0 (nnrss-find-el title channel)))) + (cons 'href url))))) + +(defun nnrss-get-namespace-prefix (el uri) + "Given EL (containing a parsed element) and URI (containing a string +that gives the URI for which you want to retrieve the namespace +prefix), return the prefix." + (let* ((prefix (car (rassoc uri (cadar el)))) + (nslist (if prefix + (split-string (symbol-name prefix) ":"))) + (ns (cond ((eq (length nslist) 1) ; no prefix given + "") + ((eq (length nslist) 2) ; extract prefix + (cadr nslist))))) + (if (and ns (not (eq ns ""))) + (concat ns ":") + ns))) + +(provide 'nnrss) + + +;;; nnrss.el ends here + +;;; arch-tag: 12910c07-0cdf-44fb-8d2c-416ded64c267 |