Update copyright year to 2016
[gnus] / lisp / nnrss.el
index 94fd55e..c17a13c 100644 (file)
@@ -1,7 +1,6 @@
 ;;; nnrss.el --- interfacing with RSS
 
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;;   2008, 2009, 2010  Free Software Foundation, Inc.
+;; Copyright (C) 2001-2016 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: RSS
 
 ;;; Code:
 
-;; For Emacs < 22.2.
-(eval-and-compile
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
 (eval-when-compile (require 'cl))
 
 (require 'gnus)
@@ -77,7 +72,8 @@ this variable to the list of fields to be ignored.")
 (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.
@@ -113,11 +109,6 @@ 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
@@ -196,9 +187,6 @@ used to render text.  If it is nil, text will simply be folded.")
 (deffoo nnrss-close-group (group &optional server)
   t)
 
-(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)
@@ -239,46 +227,25 @@ used to render text.  If it is nil, text will simply be folded.")
            (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-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")))))
+             (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
@@ -392,12 +359,13 @@ used to render text.  If it is nil, text will simply be folded.")
 
 (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 group nnrss-server-data)))
+      (let ((elem (assoc (gnus-group-decoded-name group) nnrss-server-data)))
        (insert (format "%S %s 1 y\n" group (or (cadr elem) 0)))))
     'active))
 
@@ -426,8 +394,8 @@ otherwise return nil."
                                         nnrss-compatible-encoding-alist)))))
     (mm-coding-system-p 'utf-8)))
 
-(declare-function w3-parse-buffer "ext:w3-parse" (&optional buff))
-
+(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
@@ -454,22 +422,14 @@ otherwise return nil."
                  (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
@@ -627,7 +587,7 @@ which RSS 2.0 allows."
 (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)
@@ -642,8 +602,6 @@ which RSS 2.0 allows."
        (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)
@@ -702,9 +660,6 @@ which RSS 2.0 allows."
            (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/")
@@ -911,8 +866,7 @@ Careful with this on large documents!"
 
 (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)))
@@ -964,30 +918,30 @@ whether they are `offsite' or `onsite'."
      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' (URL `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
@@ -1000,9 +954,9 @@ whether they are `offsite' or `onsite'."
                      (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)