X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnrss.el;h=6735eda1380f1887c7459d74091f8a68bc40078a;hb=841d53a55d86cea586481932a87b6b0bd32c8c93;hp=6e94f090048bb12b793b645665a2662d876938ec;hpb=e6b31519e256eaa52280b45df80d5b436c1539b1;p=elisp%2Fgnus.git- diff --git a/lisp/nnrss.el b/lisp/nnrss.el index 6e94f09..6735eda 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -54,7 +54,7 @@ (defvoo nnrss-group-max 0) (defvoo nnrss-group-min 1) (defvoo nnrss-group nil) -(defvoo nnrss-group-hashtb nil) +(defvoo nnrss-group-hashtb (make-hash-table :test 'equal)) (defvoo nnrss-status-string "") (defconst nnrss-version "nnrss 1.0") @@ -232,14 +232,8 @@ ARTICLE is the article number of the current headline.") (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))) + (ignore-errors + (delete-file (nnrss-make-filename group server))) t) (deffoo nnrss-request-list-newsgroups (&optional server) @@ -312,89 +306,62 @@ ARTICLE is the article number of the current headline.") (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))) + (let ((file (nnrss-make-filename "nnrss" server))) (when (file-exists-p file) - (with-temp-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)))))) + (let ((coding-system-for-read 'binary)) + (load file nil nil t))))) (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) - (output-coding-system '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"))))) + (let ((coding-system-for-write 'binary)) + (with-temp-file (nnrss-make-filename "nnrss" server) + (gnus-prin1 `(setq nnrss-group-alist ',nnrss-group-alist)) + (gnus-prin1 `(setq nnrss-server-data ',nnrss-server-data))))) (defun nnrss-read-group-data (group server) (setq nnrss-group-data nil) - (setq nnrss-group-hashtb (gnus-make-hashtable)) + (if (hash-table-p nnrss-group-hashtb) + (clrhash nnrss-group-hashtb) + (setq nnrss-group-hashtb (make-hash-table :test 'equal))) (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))) + (let ((file (nnrss-make-filename group server))) (when (file-exists-p file) - (with-temp-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))) + (let ((coding-system-for-read 'binary)) + (load file nil t t)) (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))))))) + (puthash (nth 2 e) e 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))) + (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) - (output-coding-system 'binary) - print-level print-length) - (with-temp-file file - (insert "(setq nnrss-group-data '" - (prin1-to-string nnrss-group-data) - ")\n"))))) + (let ((coding-system-for-write 'binary)) + (with-temp-file (nnrss-make-filename group server) + (gnus-prin1 `(setq nnrss-group-data ',nnrss-group-data ))))) + +(defun nnrss-make-filename (name server) + (expand-file-name + (nnrss-translate-file-chars + (concat name + (and server + (not (equal server "")) + "-") + server + ".el")) + nnrss-directory)) + +(gnus-add-shutdown 'nnrss-close 'gnus) + +(defun nnrss-close () + "Clear internal nnrss variables." + (setq nnrss-group-data nil + nnrss-server-data nil + nnrss-group-hashtb nil + nnrss-group-alist nil)) ;;; URL interface @@ -428,7 +395,7 @@ ARTICLE is the article number of the current headline.") (nnrss-translate-file-chars (concat group ".xml")) nnrss-directory)))) - (nnrss-fetch file t) + (setq xml (nnrss-fetch file t)) (setq url (or (nth 2 (assoc group nnrss-server-data)) (second (assoc group nnrss-group-alist)))) (unless url @@ -456,12 +423,13 @@ ARTICLE is the article number of the current headline.") (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))) + (not (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 '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))) @@ -475,7 +443,7 @@ ARTICLE is the article number of the current headline.") date (and extra (nnrss-decode-entities-unibyte-string extra))) nnrss-group-data) - (gnus-sethash url (car nnrss-group-data) nnrss-group-hashtb) + (puthash url (car nnrss-group-data) nnrss-group-hashtb) (setq changed t))) (when changed (nnrss-save-group-data group server) @@ -688,48 +656,50 @@ whether they are `offsite' or `onsite'." (defun nnrss-find-rss-via-syndic8 (url) "query syndic8 for the rss feeds it has for the url." - (if (locate-library "xml-rpc") - (progn (require 'xml-rpc) - (let ((feedid (xml-rpc-method-call - "http://www.syndic8.com/xmlrpc.php" - 'syndic8.FindSites - url))) - (if 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 (> (length urllist) 1) - (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))) - (cdar urllist)))))) - (error (message "XML-RPC is not available... not checking Syndic8.")))) + (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