X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnrss.el;h=55dd46067b07ec4dd8d08bd5658668bc750ff807;hb=e2696774a2e225ea60d46cc665d4232c80412731;hp=de4a5a96c718b6fa5b930aee5f16cf70456af0c6;hpb=818235ac7f33073995ec59721791f461dce5ea34;p=elisp%2Fgnus.git- diff --git a/lisp/nnrss.el b/lisp/nnrss.el index de4a5a9..55dd460 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -253,31 +253,31 @@ ARTICLE is the article number of the current headline.") (defun nnrss-fetch (url &optional local) "Fetch 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) + ;;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)))) + ;; 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 @@ -331,7 +331,7 @@ ARTICLE is the article number of the current headline.") (let ((coding-system-for-read 'binary)) (load file nil t t)) (dolist (e nnrss-group-data) - (puthash (nth 2 e) e nnrss-group-hashtb) + (puthash (or (nth 2 e) (nth 5 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))) @@ -341,7 +341,7 @@ ARTICLE is the article number of the current headline.") (gnus-make-directory nnrss-directory) (let ((coding-system-for-write 'binary)) (with-temp-file (nnrss-make-filename group server) - (gnus-prin1 `(setq nnrss-group-data ',nnrss-group-data ))))) + (gnus-prin1 `(setq nnrss-group-data ',nnrss-group-data))))) (defun nnrss-make-filename (name server) (expand-file-name @@ -420,12 +420,16 @@ ARTICLE is the article number of the current headline.") 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 (gethash url nnrss-group-hashtb))) + (string= (concat rss-ns "item") (car item)) + (if (setq url (nnrss-decode-entities-unibyte-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) + (nnrss-node-text rss-ns 'description item))) + (not (gethash extra nnrss-group-hashtb)))) (setq subject (nnrss-node-text rss-ns 'title item)) - (setq extra (or (nnrss-node-text content-ns 'encoded item) + (setq extra (or extra + (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) @@ -443,8 +447,9 @@ ARTICLE is the article number of the current headline.") date (and extra (nnrss-decode-entities-unibyte-string extra))) nnrss-group-data) - (puthash url (car nnrss-group-data) nnrss-group-hashtb) - (setq changed t))) + (puthash (or url extra) t nnrss-group-hashtb) + (setq changed t)) + (setq extra nil)) (when changed (nnrss-save-group-data group server) (let ((pair (assoc group nnrss-server-data))) @@ -484,11 +489,11 @@ Export subscriptions to a buffer in OPML Format." " " (user-full-name) "\n" " \n" " \n")) - (mapcar (lambda (sub) - (insert (concat - " \n"))) - nnrss-group-alist) + (mapc (lambda (sub) + (insert (concat + " \n"))) + nnrss-group-alist) (insert (concat " \n" "\n"))) @@ -565,24 +570,24 @@ 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!" - (if (listp data) - (mapcar (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 (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)) found-list) (defun nnrss-rsslink-p (el) @@ -629,27 +634,27 @@ 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) - (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) + (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) (append rss-onsite-end rdf-onsite-end xml-onsite-end rss-onsite-in rdf-onsite-in xml-onsite-in @@ -774,7 +779,7 @@ prefix), return the prefix." "") ((eq (length nslist) 2) ; extract prefix (cadr nslist))))) - (if (and ns (not (eq ns ""))) + (if (and ns (not (string= ns ""))) (concat ns ":") ns)))