X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnrss.el;h=4560b5b1aa857e8a3bafc201bc9e35ec35e90a05;hb=31c2d28954e12186abf163efda39de9c53183a68;hp=55dd46067b07ec4dd8d08bd5658668bc750ff807;hpb=8905e3349bb43cd632b7fa186d8530a8dbcdc7d6;p=elisp%2Fgnus.git- diff --git a/lisp/nnrss.el b/lisp/nnrss.el index 55dd460..4560b5b 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -1,5 +1,6 @@ ;;; nnrss.el --- interfacing with RSS -;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc. + +;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: RSS @@ -18,8 +19,8 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -31,16 +32,24 @@ (require 'nnoo) (require 'nnmail) (require 'message) -(require 'mm-util) +(require 'nnheader) (require 'gnus-util) (require 'time-date) -(require 'rfc2231) +(require 'mime-parse) (require 'mm-url) +(require 'eword-encode) +(require 'mime-edit) +(require 'mime-view) (eval-when-compile (ignore-errors - (require 'xml))) + (require 'xml))) (eval '(require 'xml)) +;; Reload mm-util emulating macros for compiling. +(eval-when-compile + (let ((features (delq 'mm-util (copy-sequence features)))) + (load "nnheader" nil t))) + (nnoo-declare nnrss) (defvoo nnrss-directory (nnheader-concat gnus-directory "rss/") @@ -78,11 +87,29 @@ 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.") +(defvar nnrss-file-coding-system nnheader-auto-save-coding-system + "Coding system used when reading and writing files.") + +(defvar nnrss-compatible-encoding-alist '((iso-8859-1 . windows-1252)) + "Alist of encodings and those supersets. +The cdr of each element is used to decode data if it is available when +the car is what the data specify as the encoding. Or, the car is used +for decoding when the cdr that the data specify is not available.") + (nnoo-define-basics nnrss) ;;; Interface functions +(defsubst nnrss-format-string (string) + (gnus-replace-in-string string " *\n *" " ")) + +(defun nnrss-decode-group-name (group) + (if (and group (mm-coding-system-p 'utf-8)) + (setq group (mm-decode-coding-string group 'utf-8)) + group)) + (deffoo nnrss-retrieve-headers (articles &optional group server fetch-old) + (setq group (nnrss-decode-group-name group)) (nnrss-possibly-change-group group server) (let (e) (save-excursion @@ -91,21 +118,26 @@ ARTICLE is the article number of the current headline.") (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 + ;; subject + (or (nth 3 e) "") + "\t" + ;; from + (or (nth 4 e) "(nobody)") + "\t" + ;; date (or (nth 5 e) "") - "\t" ;; date + "\t" + ;; id (format "<%d@%s.nnrss>" (car e) group) - "\t" ;; id - "\t" ;; refs - "-1" "\t" ;; chars - "-1" "\t" ;; lines - "" "\t" ;; Xref + "\t" + ;; refs + "\t" + ;; chars + "-1" "\t" + ;; lines + "-1" "\t" + ;; Xref + "" "\t" (if (and (nth 6 e) (memq nnrss-description-field nnmail-extra-headers)) @@ -126,69 +158,112 @@ ARTICLE is the article number of the current headline.") 'nov) (deffoo nnrss-request-group (group &optional server dont-check) + (setq group (nnrss-decode-group-name group)) + (nnheader-message 6 "nnrss: Requesting %s..." group) (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))) + (prog1 + (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)) + (nnheader-message 6 "nnrss: Requesting %s...done" group))) (deffoo nnrss-close-group (group &optional server) t) +(defun nnrss-body-presentation-method () + "Return a body presentation method used with MIME-View. +The return value will be `html' or `text'." + (in-calist-package 'mime-view) + (let ((default (cdr (assq 'body-presentation-method + (car (ctree-find-calist + mime-preview-condition + '((type . text) (subtype . t))))))) + (html (cdr (assq 'body-presentation-method + (car (ctree-find-calist + mime-preview-condition + '((type . text) (subtype . html)))))))) + (if (or (not default) + (not html) + (eq default html)) + 'text + 'html))) + (deffoo nnrss-request-article (article &optional group server buffer) + (setq group (nnrss-decode-group-name group)) + (when (stringp article) + (setq article (if (string-match "\\`<\\([0-9]+\\)@" article) + (string-to-number (match-string 1 article)) + 0))) (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))) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (if group + (mm-with-unibyte-current-buffer + (insert "Newsgroups: " + (if (mm-coding-system-p 'utf-8) + (mm-encode-coding-string group 'utf-8) + group) + "\n"))) + (if (nth 3 e) + (insert "Subject: " (nth 3 e) "\n")) + (if (nth 4 e) + (insert "From: " (nth 4 e) "\n")) + (if (nth 5 e) + (insert "Date: " (nnrss-format-string (nth 5 e)) "\n")) + (insert (format "Message-ID: <%d@%s.nnrss>\n" + (car e) + (gnus-replace-in-string group "[\t\n ]+" "_"))) + (insert "\n") + (let ((text (if (nth 6 e) + (mapconcat 'identity + (delete "" (split-string (nth 6 e) "\n+")) + " "))) + (link (nth 2 e)) + (enclosure (nth 7 e)) + (comments (nth 8 e)) + (mail-header-separator "") + mime-edit-insert-user-agent-field) + (when (or text link enclosure comments) + (if (eq 'html (nnrss-body-presentation-method)) + (progn + (mime-edit-insert-text "html") + (insert "\n") + (when text + (insert text "\n")) + (when link + (insert "

link

\n")) + (when enclosure + (insert "

" + (cadr enclosure) " " (nth 2 enclosure) + " " (nth 3 enclosure) "

\n")) + (when comments + (insert "

comments

\n")) + (insert "\n")) + (mime-edit-insert-text "plain") (when text - (insert text) - (goto-char point) - (while (re-search-forward "\n" nil t) - (replace-match " ")) - (goto-char (point-max)) - (insert "\n\n")) + (insert text "\n") + (when (or link enclosure) + (insert "\n"))) (when link - (insert link))) - (insert "\n\n--" boundary "\nContent-Type: text/html\n\n") - (let ((point (point))) - (when text - (insert "\n" text "\n") - (goto-char point) - (while (re-search-forward "\n" nil t) - (replace-match " ")) - (goto-char (point-max)) - (insert "\n\n")) - (when link - (insert "

link

\n")))) - (when nnrss-content-function - (funcall nnrss-content-function e group article))))) + (insert link "\n")) + (when enclosure + (insert (car enclosure) " " + (nth 2 enclosure) " " + (nth 3 enclosure) "\n")) + (when comments + (insert comments "\n"))) + (mime-edit-translate-body))) + (when nnrss-content-function + (funcall nnrss-content-function e group article)))) (cond (err (nnheader-report 'nnrss err)) @@ -211,6 +286,7 @@ ARTICLE is the article number of the current headline.") (deffoo nnrss-request-expire-articles (articles group &optional server force) + (setq group (nnrss-decode-group-name group)) (nnrss-possibly-change-group group server) (let (e days not-expirable changed) (dolist (art articles) @@ -228,12 +304,18 @@ ARTICLE is the article number of the current headline.") not-expirable)) (deffoo nnrss-request-delete-group (group &optional force server) + (setq group (nnrss-decode-group-name group)) (nnrss-possibly-change-group group server) + (let (elem) + ;; There may be two or more entries in `nnrss-group-alist' since + ;; this function didn't delete them formerly. + (while (setq elem (assoc group nnrss-group-alist)) + (setq nnrss-group-alist (delq elem nnrss-group-alist)))) (setq nnrss-server-data (delq (assoc group nnrss-server-data) nnrss-server-data)) (nnrss-save-server-data server) (ignore-errors - (delete-file (nnrss-make-filename group server))) + (delete-file (nnrss-make-filename group server))) t) (deffoo nnrss-request-list-newsgroups (&optional server) @@ -250,16 +332,49 @@ ARTICLE is the article number of the current headline.") ;;; Internal functions (eval-when-compile (defun xml-rpc-method-call (&rest args))) + +(defun nnrss-get-encoding () + "Return an encoding attribute specified in the current xml contents. +If `nnrss-compatible-encoding-alist' specifies the compatible encoding, +it is used instead. If the xml contents doesn't specify the encoding, +return `utf-8' which is the default encoding for xml if it is available, +otherwise return nil." + (goto-char (point-min)) + (if (re-search-forward + "<\\?[^>]*encoding=\\(?:\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)" + nil t) + (let ((encoding (intern (downcase (or (match-string 1) + (match-string 2)))))) + (or + (mm-coding-system-p (cdr (assq encoding + nnrss-compatible-encoding-alist))) + (mm-coding-system-p encoding) + (mm-coding-system-p (car (rassq encoding + nnrss-compatible-encoding-alist))))) + (mm-coding-system-p 'utf-8))) + (defun nnrss-fetch (url &optional local) "Fetch URL and put it in a the expected Lisp structure." - (with-temp-buffer + (mm-with-unibyte-buffer ;;some CVS versions of url.el need this to close the connection quickly - (let (xmlform htmlform) + (let (cs 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)) + (let (;; FIXME: shouldn't binding `coding-system-for-read' be + ;; moved to `mm-url-insert'? + (coding-system-for-read 'binary) + ;; mm-url will load mm-util. d-e-m-c should be bound to + ;; t then, because of `mm-emacs-mule'. + (default-enable-multibyte-characters t)) + (mm-url-insert url))) + (nnheader-remove-cr-followed-by-lf) + ;; Decode text according to the encoding attribute. + (when (setq cs (nnrss-get-encoding)) + (mm-decode-coding-region (point-min) (point-max) cs) + (mm-enable-multibyte)) + (goto-char (point-min)) ;; 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 @@ -268,13 +383,16 @@ ARTICLE is the article number of the current headline.") ;; why w3-parse-buffer fails to parse some well-formed xml and ;; fix it. - (condition-case err + (condition-case err1 (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)))) + (error + (condition-case err2 + (setq htmlform (caddar (w3-parse-buffer + (current-buffer)))) + (error + (message "\ +nnrss: %s: Not valid XML %s and w3-parse doesn't work %s" + url err1 err2))))) (if htmlform htmlform xmlform)))) @@ -290,9 +408,8 @@ ARTICLE is the article number of the current headline.") (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))) + (when (y-or-n-p "Fetch extra categories? ") + (mapc 'funcall nnrss-extra-categories)) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) @@ -308,14 +425,23 @@ ARTICLE is the article number of the current headline.") (setq nnrss-server-data nil) (let ((file (nnrss-make-filename "nnrss" server))) (when (file-exists-p file) - (let ((coding-system-for-read 'binary)) - (load file nil nil t))))) + ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII + ;; file names. So, we use `insert-file-contents' instead. + (mm-with-multibyte-buffer + (let ((coding-system-for-read nnrss-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) + (insert-file-contents file) + (eval-region (point-min) (point-max))))))) (defun nnrss-save-server-data (server) (gnus-make-directory nnrss-directory) - (let ((coding-system-for-write 'binary)) + (let ((coding-system-for-write nnrss-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) (with-temp-file (nnrss-make-filename "nnrss" server) + (insert (format ";; -*- coding: %s; -*-\n" + nnrss-file-coding-system)) (gnus-prin1 `(setq nnrss-group-alist ',nnrss-group-alist)) + (insert "\n") (gnus-prin1 `(setq nnrss-server-data ',nnrss-server-data))))) (defun nnrss-read-group-data (group server) @@ -328,10 +454,15 @@ ARTICLE is the article number of the current headline.") (setq nnrss-group-min (+ nnrss-group-max 1))) (let ((file (nnrss-make-filename group server))) (when (file-exists-p file) - (let ((coding-system-for-read 'binary)) - (load file nil t t)) + ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII + ;; file names. So, we use `insert-file-contents' instead. + (mm-with-multibyte-buffer + (let ((coding-system-for-read nnrss-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) + (insert-file-contents file) + (eval-region (point-min) (point-max)))) (dolist (e nnrss-group-data) - (puthash (or (nth 2 e) (nth 5 e)) t nnrss-group-hashtb) + (puthash (or (nth 2 e) (nth 6 e)) t nnrss-group-hashtb) (when (and (car e) (> nnrss-group-min (car e))) (setq nnrss-group-min (car e))) (when (and (car e) (< nnrss-group-max (car e))) @@ -339,8 +470,11 @@ ARTICLE is the article number of the current headline.") (defun nnrss-save-group-data (group server) (gnus-make-directory nnrss-directory) - (let ((coding-system-for-write 'binary)) + (let ((coding-system-for-write nnrss-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) (with-temp-file (nnrss-make-filename group server) + (insert (format ";; -*- coding: %s; -*-\n" + nnrss-file-coding-system)) (gnus-prin1 `(setq nnrss-group-data ',nnrss-group-data))))) (defun nnrss-make-filename (name server) @@ -372,24 +506,35 @@ ARTICLE is the article number of the current headline.") (mm-with-unibyte-current-buffer (mm-url-insert url))) -(defun nnrss-decode-entities-unibyte-string (string) +(defun nnrss-decode-entities-string (string) (if string - (mm-with-unibyte-buffer + (mm-with-multibyte-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)) +(defun nnrss-mime-encode-string (string) + (mm-with-multibyte-buffer + (insert string) + (mm-url-decode-entities-nbsp) + (goto-char (point-min)) + (while (re-search-forward "[\t\n ]+" nil t) + (replace-match " ")) + (goto-char (point-min)) + (skip-chars-forward " ") + (delete-region (point-min) (point)) + (goto-char (point-max)) + (skip-chars-forward " ") + (delete-region (point) (point-max)) + (eword-encode-string (buffer-string) (eval '(- -1 (lsh -1 -1)))))) ;;; 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) + (let (file xml subject url extra changed author date + enclosure comments 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 @@ -400,11 +545,11 @@ ARTICLE is the article number of the current headline.") (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://"))))) + (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)) @@ -421,7 +566,7 @@ ARTICLE is the article number of the current headline.") (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml))) (when (and (listp item) (string= (concat rss-ns "item") (car item)) - (if (setq url (nnrss-decode-entities-unibyte-string + (if (setq url (nnrss-decode-entities-string (nnrss-node-text rss-ns 'link (cddr item)))) (not (gethash url nnrss-group-hashtb)) (setq extra (or (nnrss-node-text content-ns 'encoded item) @@ -437,19 +582,43 @@ ARTICLE is the article number of the current headline.") (setq date (or (nnrss-node-text dc-ns 'date item) (nnrss-node-text rss-ns 'pubDate item) (message-make-date))) + (setq comments (nnrss-node-text rss-ns 'comments item)) + (when (setq enclosure (cadr (assq (intern (concat rss-ns "enclosure")) item))) + (let ((url (cdr (assq 'url enclosure))) + (len (cdr (assq 'length enclosure))) + (type (cdr (assq 'type enclosure))) + (name)) + (setq len + (if (and len (integerp (setq len (string-to-number len)))) + ;; actually already in `ls-lisp-format-file-size' but + ;; probably not worth to require it for one function + (do ((size (/ len 1.0) (/ size 1024.0)) + (post-fixes (list "" "k" "M" "G" "T" "P" "E") + (cdr post-fixes))) + ((< size 1024) + (format "%.1f%s" size (car post-fixes)))) + "0")) + (setq url (or url "")) + (setq name (if (string-match "/\\([^/]*\\)$" url) + (match-string 1 url) + "file")) + (setq type (or type "")) + (setq enclosure (list url name len type)))) (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)) + (and subject (nnrss-mime-encode-string subject)) + (and author (nnrss-mime-encode-string author)) date - (and extra (nnrss-decode-entities-unibyte-string extra))) + (and extra (nnrss-decode-entities-string extra)) + enclosure + comments) nnrss-group-data) (puthash (or url extra) t nnrss-group-hashtb) (setq changed t)) - (setq extra nil)) + (setq extra nil)) (when changed (nnrss-save-group-data group server) (let ((pair (assoc group nnrss-server-data))) @@ -464,12 +633,12 @@ Read the file and attempt to subscribe to each Feed in the file." (interactive "fImport file: ") (mapcar (lambda (node) (gnus-group-make-rss-group - (cdr (assq 'xmlUrl (cadr node))))) + (cdr (assq 'xmlUrl (cadr node))))) (nnrss-find-el 'outline - (progn - (find-file opml-file) - (xml-parse-region (point-min) - (point-max)))))) + (progn + (find-file opml-file) + (xml-parse-region (point-min) + (point-max)))))) (defun nnrss-opml-export () "OPML subscription export. @@ -477,26 +646,22 @@ Export subscriptions to a buffer in OPML Format." (interactive) (with-current-buffer (get-buffer-create "*OPML Export*") (mm-set-buffer-file-coding-system 'utf-8) - (insert (concat - "\n" - "\n" - "\n" - " \n" - " mySubscriptions\n" - " " (format-time-string "%a, %d %b %Y %T %z") - "\n" - " " user-mail-address "\n" - " " (user-full-name) "\n" - " \n" - " \n")) - (mapc (lambda (sub) - (insert (concat - " \n"))) - nnrss-group-alist) - (insert (concat - " \n" - "\n"))) + (insert "\n" + "\n" + "\n" + " \n" + " mySubscriptions\n" + " " (format-time-string "%a, %d %b %Y %T %z") + "\n" + " " user-mail-address "\n" + " " (user-full-name) "\n" + " \n" + " \n") + (dolist (sub nnrss-group-alist) + (insert " \n")) + (insert " \n" + "\n")) (pop-to-buffer "*OPML Export*") (when (fboundp 'sgml-mode) (sgml-mode))) @@ -537,8 +702,8 @@ It is useful when `(setq nnrss-use-local t)'." (setq category (match-string 1)) (setq url (match-string 2) name (mm-url-decode-entities-string - (rfc2231-decode-encoded-string - (match-string 3)))) + (cadr (mime-decode-parameters + (list "c*" (match-string 3)))))) (if category (setq name (concat category "." name))) (unless (assoc name nnrss-server-data) @@ -547,17 +712,17 @@ It is useful when `(setq nnrss-use-local t)'." (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]+\\|^ +\\| +$" "")))) + (cleaned-text (if text + (gnus-replace-in-string + (gnus-replace-in-string + text "^[\000-\037\177]+\\|^ +\\| +$" "") + "\r\n" "\n")))) (if (string-equal "" cleaned-text) nil cleaned-text))) @@ -570,24 +735,27 @@ It is useful when `(setq nnrss-use-local t)'." (defun nnrss-find-el (tag data &optional found-list) "Find the all matching elements in the data. Careful with this on large documents!" - (when (listp data) - (mapc (lambda (bit) - (when (car-safe bit) - (when (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)) + (when (consp data) + (dolist (bit data) + (when (car-safe bit) + (when (equal tag (car bit)) + ;; Old xml.el may return a list of string. + (when (and (consp (caddr bit)) + (stringp (caaddr bit))) + (setcar (cddr bit) (caaddr bit))) + (setq found-list + (append found-list + (list bit)))) + (if (and (consp (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)))))))) found-list) (defun nnrss-rsslink-p (el) @@ -613,12 +781,11 @@ DATA should be the output of `xml-parse-region' or (cdr (assoc 'href (cadr ahref)))) (nnrss-find-el 'a data))) -(defmacro nnrss-match-macro (base-uri item - onsite-list offsite-list) +(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)))))) + (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: @@ -634,27 +801,26 @@ whether they are `offsite' or `onsite'." 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) - (mapc (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) + (dolist (href hrefs) + (cond ((null href)) + ((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)))) (append rss-onsite-end rdf-onsite-end xml-onsite-end rss-onsite-in rdf-onsite-in xml-onsite-in @@ -691,17 +857,17 @@ whether they are `offsite' or `onsite'." (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 + (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)))))))) + (nnrss-find-rss-via-syndic8 url)))))))) (defun nnrss-find-rss-via-syndic8 (url) "Query syndic8 for the rss feeds it has for URL." @@ -742,7 +908,7 @@ whether they are `offsite' or `onsite'." (selection (mapcar (lambda (listinfo) (cons (cdr (assoc "sitename" listinfo)) - (string-to-int + (string-to-number (cdr (assoc "feedid" listinfo))))) feedinfo))) (cdr (assoc @@ -787,4 +953,3 @@ prefix), return the prefix." ;;; nnrss.el ends here -