;;; nnrss.el --- interfacing with RSS
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
-;; 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; 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 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 3 of the License, 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.
+;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvoo nnrss-directory (nnheader-concat gnus-directory "rss/")
"Where nnrss will save its files.")
+(defvoo nnrss-ignore-article-fields '(slash:comments)
+ "*List of fields that should be ignored when comparing RSS articles.
+Some RSS feeds update article fields during their lives, e.g. to
+indicate the number of comments or the number of times the
+articles have been seen. However, if there is a difference
+between the local article and the distant one, the latter is
+considered to be new. To avoid this and discard some fields, set
+this variable to the list of fields to be ignored.")
+
;; (group max rss-url)
(defvoo nnrss-server-data nil)
(defvar nnrss-group-alist '()
"List of RSS addresses.")
-(defvar nnrss-use-local nil)
+(defvar nnrss-use-local nil
+ "If non-nil nnrss will read the feeds from local files in nnrss-directory.")
(defvar nnrss-description-field 'X-Gnus-Description
"Field name used for DESCRIPTION.
ARTICLE is the article number of the current headline.")
(defvar nnrss-file-coding-system mm-universal-coding-system
- "Coding system used when reading and writing files.")
-
-(defvar nnrss-compatible-encoding-alist '((iso-8859-1 . windows-1252))
+ "*Coding system used when reading and writing files.
+If you run Gnus with various versions of Emacsen, the value of this
+variable should be the coding system that all those Emacsen support.
+Note that you have to regenerate all the nnrss groups if you change
+the value. Moreover, you should be patient even if you are made to
+read the same articles twice, that arises for the difference of the
+versions of xml.el.")
+
+(defvar nnrss-compatible-encoding-alist
+ (delq nil (mapcar (lambda (elem)
+ (if (and (mm-coding-system-p (car elem))
+ (mm-coding-system-p (cdr elem)))
+ elem))
+ mm-charset-override-alist))
"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.")
-(defvar nnrss-wash-html-in-text-plain-parts nil
- "*Non-nil means render text in text/plain parts as HTML.
-The function specified by the `mm-text-html-renderer' variable will be
-used to render text. If it is nil, text will simply be folded.")
-
(nnoo-define-basics nnrss)
;;; Interface functions
(setq group (nnrss-decode-group-name group))
(nnrss-possibly-change-group group server)
(let (e)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(dolist (article articles)
(if (setq e (assq article nnrss-group-data))
"\n")))))
'nov)
-(deffoo nnrss-request-group (group &optional server dont-check)
+(deffoo nnrss-request-group (group &optional server dont-check info)
(setq group (nnrss-decode-group-name group))
(nnheader-message 6 "nnrss: Requesting %s..." group)
(nnrss-possibly-change-group group server)
(deffoo nnrss-close-group (group &optional server)
t)
-(eval-when-compile
- (defvar mm-text-html-renderer)
- (defvar mm-text-html-washer-alist))
-
(deffoo nnrss-request-article (article &optional group server buffer)
(setq group (nnrss-decode-group-name group))
(when (stringp article)
(link (nth 2 e))
(enclosure (nth 7 e))
(comments (nth 8 e))
- ;; Enable encoding of Newsgroups header in XEmacs.
- (default-enable-multibyte-characters t)
(rfc2047-header-encoding-alist
(if (mm-coding-system-p 'utf-8)
(cons '("Newsgroups" . utf-8)
(when text
(insert text)
(goto-char body)
- (if (and nnrss-wash-html-in-text-plain-parts
- (progn
- (require 'mm-view)
- (setq fn (or (cdr (assq mm-text-html-renderer
- mm-text-html-washer-alist))
- mm-text-html-renderer))))
- (progn
- (narrow-to-region body (point-max))
- (if (functionp fn)
- (funcall fn)
- (apply (car fn) (cdr fn)))
- (widen)
- (goto-char body)
- (re-search-forward "[^\t\n ]" nil t)
- (beginning-of-line)
- (delete-region body (point))
- (goto-char (point-max))
- (skip-chars-backward "\t\n ")
- (end-of-line)
- (delete-region (point) (point-max))
- (insert "\n"))
- (while (re-search-forward "\n+" nil t)
- (replace-match " "))
- (goto-char body)
- ;; See `nnrss-check-group', which inserts "<br /><br />".
- (when (search-forward "<br /><br />" nil t)
- (if (eobp)
- (replace-match "\n")
- (replace-match "\n\n")))
- (unless (eobp)
- (let ((fill-column default-fill-column)
- (window (get-buffer-window nntp-server-buffer)))
- (when window
- (setq fill-column
- (max 1 (/ (* (window-width window) 7) 8))))
- (fill-region (point) (point-max))
- (goto-char (point-max))
- ;; XEmacs version of `fill-region' inserts newline.
- (unless (bolp)
- (insert "\n")))))
+ (while (re-search-forward "\n+" nil t)
+ (replace-match " "))
+ (goto-char body)
+ ;; See `nnrss-check-group', which inserts "<br /><br />".
+ (when (search-forward "<br /><br />" nil t)
+ (if (eobp)
+ (replace-match "\n")
+ (replace-match "\n\n")))
+ (unless (eobp)
+ (let ((fill-column (default-value 'fill-column))
+ (window (get-buffer-window nntp-server-buffer)))
+ (when window
+ (setq fill-column
+ (max 1 (/ (* (window-width window) 7) 8))))
+ (fill-region (point) (point-max))
+ (goto-char (point-max))
+ ;; XEmacs version of `fill-region' inserts newline.
+ (unless (bolp)
+ (insert "\n"))))
(when (or link enclosure)
(insert "\n")))
(when link
"<#/part>\n"
"<#/multipart>\n"))
(condition-case nil
- (mml-to-mime)
+ ;; Allow `mml-to-mime' to generate MIME article without
+ ;; making inquiry to a user for unknown encoding.
+ (let ((mml-confirmation-set
+ (cons 'unknown-encoding mml-confirmation-set)))
+ (mml-to-mime))
(error
(erase-buffer)
(insert header
;; 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)
(delq (assoc group nnrss-server-data) nnrss-server-data))
(nnrss-save-server-data server)
(ignore-errors
- (delete-file (nnrss-make-filename group server)))
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
+ (delete-file (nnrss-make-filename group server))))
t)
(deffoo nnrss-request-list-newsgroups (&optional server)
(nnrss-possibly-change-group nil server)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(dolist (elem nnrss-group-alist)
(if (third elem)
(insert (car elem) "\t" (third elem) "\n"))))
t)
+(deffoo nnrss-retrieve-groups (groups &optional server)
+ (dolist (group groups)
+ (setq group (nnrss-decode-group-name group))
+ (nnrss-possibly-change-group group server)
+ (nnrss-check-group group server))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (dolist (group groups)
+ (let ((elem (assoc (gnus-group-decoded-name group) nnrss-server-data)))
+ (insert (format "%S %s 1 y\n" group (or (cadr elem) 0)))))
+ 'active))
+
(nnoo-define-skeleton nnrss)
;;; Internal functions
nnrss-compatible-encoding-alist)))))
(mm-coding-system-p 'utf-8)))
+(declare-function libxml-parse-html-region "xml.c"
+ (start end &optional base-url discard-comments))
(defun nnrss-fetch (url &optional local)
"Fetch URL and put it in a the expected Lisp structure."
(mm-with-unibyte-buffer
- ;;some CVS versions of url.el need this to close the connection quickly
+ ;;some versions of url.el need this to close the connection quickly
(let (cs xmlform htmlform)
;; bit o' work necessary for w3 pre-cvs and post-cvs
(if local
(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))
+ (insert (prog1
+ (mm-decode-coding-string (buffer-string) cs)
+ (erase-buffer)
+ (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
- ;; 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 err1
(setq xmlform (xml-parse-region (point-min) (point-max)))
(error
(condition-case err2
- (setq htmlform (caddar (w3-parse-buffer
- (current-buffer))))
+ (setq htmlform (libxml-parse-html-region (point-min) (point-max)))
(error
(message "\
-nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
+nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s"
url err1 err2)))))
(if htmlform
htmlform
(nnrss-read-group-data group server)
(setq nnrss-group group)))
-(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories))
-
-(defun nnrss-generate-active ()
- (when (y-or-n-p "Fetch extra categories? ")
- (mapc 'funcall nnrss-extra-categories))
- (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")))))
-
-(eval-and-compile (autoload 'timezone-parse-date "timezone"))
+(autoload 'timezone-parse-date "timezone")
(defun nnrss-normalize-date (date)
"Return a date string of DATE in the RFC822 style.
This function handles the ISO 8601 date format described in
-<URL:http://www.w3.org/TR/NOTE-datetime>, and also the RFC822 style
+URL `http://www.w3.org/TR/NOTE-datetime', and also the RFC822 style
which RSS 2.0 allows."
- (let (case-fold-search vector year month day time zone cts)
- (cond ((null date))
+ (let (case-fold-search vector year month day time zone cts given)
+ (cond ((null date)) ; do nothing for this case
+ ;; if the date is just digits (unix time stamp):
+ ((string-match "^[0-9]+$" date)
+ (setq given (seconds-to-time (string-to-number date))))
;; RFC822
((string-match " [0-9]+ " date)
(setq vector (timezone-parse-date date)
(if zone
(concat " " zone)
"")))
- (message-make-date))))
+ (message-make-date given))))
;;; data functions
(defun nnrss-read-server-data (server)
(setq nnrss-server-data nil)
- (let ((file (nnrss-make-filename "nnrss" server)))
+ (let ((file (nnrss-make-filename "nnrss" server))
+ (file-name-coding-system nnmail-pathname-coding-system))
(when (file-exists-p file)
- ;; 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)))))))
+ (load file nil t t))))
(defun nnrss-save-server-data (server)
(gnus-make-directory nnrss-directory)
(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 (nnrss-make-filename group server)))
+ (let ((file (nnrss-make-filename group server))
+ (file-name-coding-system nnmail-pathname-coding-system))
(when (file-exists-p file)
- ;; 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))))
+ (load file nil t t)
(dolist (e nnrss-group-data)
(puthash (nth 9 e) t nnrss-group-hashtb)
(when (and (car e) (> nnrss-group-min (car e)))
(defun nnrss-no-cache (url)
"")
-(defun nnrss-insert-w3 (url)
+(defun nnrss-insert (url)
(mm-with-unibyte-current-buffer
(condition-case err
(mm-url-insert url)
(mm-url-decode-entities-nbsp)
(buffer-string))))
-(defalias 'nnrss-insert 'nnrss-insert-w3)
-
(defun nnrss-mime-encode-string (string)
(mm-with-multibyte-buffer
(insert string)
(rfc2047-encode-region (point-min) (point-max)))
(goto-char (point-min))
(while (search-forward "\n" nil t)
- (delete-backward-char 1))
+ (delete-char -1))
(buffer-string)))
;;; Snarf functions
+(defun nnrss-make-hash-index (item)
+ (gnus-message 9 "nnrss: Making hash index of %s" (gnus-prin1-to-string item))
+ (setq item (gnus-remove-if
+ (lambda (field)
+ (when (listp field)
+ (memq (car field) nnrss-ignore-article-fields)))
+ item))
+ (md5 (gnus-prin1-to-string item)
+ nil nil
+ nnrss-file-coding-system))
(defun nnrss-check-group (group server)
(let (file xml subject url extra changed author date feed-subject
(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/")
(dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml)))
(when (and (listp item)
(string= (concat rss-ns "item") (car item))
- (progn (setq hash-index (md5 (gnus-prin1-to-string item)))
+ (progn (setq hash-index (nnrss-make-hash-index item))
(not (gethash hash-index nnrss-group-hashtb))))
(setq subject (nnrss-node-text rss-ns 'title item))
(setq url (nnrss-decode-entities-string
(push (list group nnrss-group-max) nnrss-server-data)))
(nnrss-save-server-data server))))
+(declare-function gnus-group-make-rss-group "gnus-group" (&optional url))
+
(defun nnrss-opml-import (opml-file)
"OPML subscriptions import.
Read the file and attempt to subscribe to each Feed in the file."
(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-node-text (namespace local-name element)
(let* ((node (assq (intern (concat namespace (symbol-name local-name)))
element))
(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'."
+DATA should be the output of `xml-parse-region'."
(mapcar (lambda (ahref)
(cdr (assoc 'href (cadr ahref))))
(nnrss-find-el 'a data)))
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)."
-
+ "Given a page, find an RSS feed.
+Use Mark Pilgrim's `ultra-liberal rss locator'."
(let ((parsed-page (nnrss-fetch url)))
-
-;; 1. if this url is the rss, use it.
+ ;; 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.
+ ;; 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
+ (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
(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
+ (if rss-link
+ rss-link
+ ;; 4. check syndic8
(nnrss-find-rss-via-syndic8 url))))))))
(defun nnrss-find-rss-via-syndic8 (url)
(cdr (assoc "feedid" listinfo)))))
feedinfo)))
(cdr (assoc
- (completing-read
- "Multiple feeds found. Select one: "
- selection nil t) urllist)))))))))
+ (gnus-completing-read
+ "Multiple feeds found. Select one"
+ selection t) urllist)))))))))
(defun nnrss-rss-p (data)
"Test if DATA is an RSS feed.
(provide 'nnrss)
-
;;; nnrss.el ends here
-
-;;; arch-tag: 12910c07-0cdf-44fb-8d2c-416ded64c267
projects / gnus / blobdiff