Quoting fixes

[gnus] / lisp / nnrss.el

diff --git a/lisp/nnrss.el b/lisp/nnrss.el
index 113bc80..1546f92 100644 (file)
--- a/lisp/nnrss.el
+++ b/lisp/nnrss.el
@@ -1,25 +1,24 @@
 ;;; nnrss.el --- interfacing with RSS
 ;;; nnrss.el --- interfacing with RSS

-;; Copyright (C) 2001, 2002, 2003, 2004, 2005  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.
 
 
 ;; 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
 
 ;; 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.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -48,6 +47,15 @@
 (defvoo nnrss-directory (nnheader-concat gnus-directory "rss/")
   "Where nnrss will save its files.")
 
 (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)
 
 ;; (group max rss-url)
 (defvoo nnrss-server-data nil)
 


@@ -64,7 +72,8 @@
 (defvar nnrss-group-alist '()
   "List of RSS addresses.")
 
 (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.
 
 (defvar nnrss-description-field 'X-Gnus-Description
   "Field name used for DESCRIPTION.


@@ -81,12 +90,23 @@ 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 mm-universal-coding-system
 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
   "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
+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)
 for decoding when the cdr that the data specify is not available.")
 
 (nnoo-define-basics nnrss)


@@ -105,8 +125,7 @@ for decoding when the cdr that the data specify is not available.")
   (setq group (nnrss-decode-group-name group))
   (nnrss-possibly-change-group group server)
   (let (e)
   (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))
       (erase-buffer)
       (dolist (article articles)
        (if (setq e (assq article nnrss-group-data))


@@ -150,7 +169,7 @@ for decoding when the cdr that the data specify is not available.")
                    "\n")))))
   'nov)
 
                    "\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)
   (setq group (nnrss-decode-group-name group))
   (nnheader-message 6 "nnrss: Requesting %s..." group)
   (nnrss-possibly-change-group group server)


@@ -190,27 +209,43 @@ for decoding when the cdr that the data specify is not available.")
        (if (nth 5 e)
            (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
        (let ((header (buffer-string))
        (if (nth 5 e)
            (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
        (let ((header (buffer-string))

-             (text (if (nth 6 e)
-                       (mapconcat 'identity
-                                  (delete "" (split-string (nth 6 e) "\n+"))
-                                  " ")))
+             (text (nth 6 e))

              (link (nth 2 e))
              (enclosure (nth 7 e))
              (link (nth 2 e))
              (enclosure (nth 7 e))

-             ;; Enable encoding of Newsgroups header in XEmacs.
-             (default-enable-multibyte-characters t)
+             (comments (nth 8 e))

              (rfc2047-header-encoding-alist
               (if (mm-coding-system-p 'utf-8)
                   (cons '("Newsgroups" . utf-8)
                         rfc2047-header-encoding-alist)
                 rfc2047-header-encoding-alist))
              (rfc2047-header-encoding-alist
               (if (mm-coding-system-p 'utf-8)
                   (cons '("Newsgroups" . utf-8)
                         rfc2047-header-encoding-alist)
                 rfc2047-header-encoding-alist))

-             rfc2047-encode-encoded-words body)
-         (when (or text link enclosure)
+             rfc2047-encode-encoded-words body fn)
+         (when (or text link enclosure comments)

            (insert "\n")
            (insert "<#multipart type=alternative>\n"
                    "<#part type=\"text/plain\">\n")
            (setq body (point))
            (when text
            (insert "\n")
            (insert "<#multipart type=alternative>\n"
                    "<#part type=\"text/plain\">\n")
            (setq body (point))
            (when text

-             (insert text "\n")
+             (insert text)
+             (goto-char body)
+             (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
              (when (or link enclosure)
                (insert "\n")))
            (when link


@@ -219,6 +254,8 @@ for decoding when the cdr that the data specify is not available.")
              (insert (car enclosure) " "
                      (nth 2 enclosure) " "
                      (nth 3 enclosure) "\n"))
              (insert (car enclosure) " "
                      (nth 2 enclosure) " "
                      (nth 3 enclosure) "\n"))

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

            (setq body (buffer-substring body (point)))
            (insert "<#/part>\n"
                    "<#part type=\"text/html\">\n"
            (setq body (buffer-substring body (point)))
            (insert "<#/part>\n"
                    "<#part type=\"text/html\">\n"


@@ -231,11 +268,17 @@ for decoding when the cdr that the data specify is not available.")
              (insert "<p><a href=\"" (car enclosure) "\">"
                      (cadr enclosure) "</a> " (nth 2 enclosure)
                      " " (nth 3 enclosure) "</p>\n"))
              (insert "<p><a href=\"" (car enclosure) "\">"
                      (cadr enclosure) "</a> " (nth 2 enclosure)
                      " " (nth 3 enclosure) "</p>\n"))

+           (when comments
+             (insert "<p><a href=\"" comments "\">comments</a></p>\n"))

            (insert "</body></html>\n"
                    "<#/part>\n"
                    "<#/multipart>\n"))
          (condition-case nil
            (insert "</body></html>\n"
                    "<#/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
            (error
             (erase-buffer)
             (insert header


@@ -265,11 +308,6 @@ for decoding when the cdr that the data specify is not available.")
       ;; we return the article number.
       (cons nnrss-group (car e))))))
 
       ;; 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)
 (deffoo nnrss-open-server (server &optional defs connectionless)
   (nnrss-read-server-data server)
   (nnoo-change-server 'nnrss server defs)


@@ -306,19 +344,31 @@ for decoding when the cdr that the data specify is not available.")
        (delq (assoc group nnrss-server-data) nnrss-server-data))
   (nnrss-save-server-data server)
   (ignore-errors
        (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)
   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)
 
     (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
 (nnoo-define-skeleton nnrss)
 
 ;;; Internal functions


@@ -344,10 +394,12 @@ otherwise return nil."
                                         nnrss-compatible-encoding-alist)))))
     (mm-coding-system-p 'utf-8)))
 
                                         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
 (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
     (let (cs xmlform htmlform)
       ;; bit o' work necessary for w3 pre-cvs and post-cvs
       (if local


@@ -356,30 +408,28 @@ otherwise return nil."
        ;; FIXME: shouldn't binding `coding-system-for-read' be moved
        ;; to `mm-url-insert'?
        (let ((coding-system-for-read 'binary))
        ;; FIXME: shouldn't binding `coding-system-for-read' be moved
        ;; to `mm-url-insert'?
        (let ((coding-system-for-read 'binary))

-         (mm-url-insert url)))
+         (condition-case err
+             (mm-url-insert url)
+           (error (if (or debug-on-quit debug-on-error)
+                      (signal (car err) (cdr err))
+                    (message "nnrss: Failed to fetch %s" url))))))

       (nnheader-remove-cr-followed-by-lf)
       ;; Decode text according to the encoding attribute.
       (when (setq cs (nnrss-get-encoding))
       (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))
 
       (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
       (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 "\
           (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
                     url err1 err2)))))
       (if htmlform
          htmlform


@@ -393,33 +443,85 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
     (nnrss-read-group-data group server)
     (setq nnrss-group group)))
 
     (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")))))
+(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
+which RSS 2.0 allows."
+  (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)
+                year (string-to-number (aref vector 0)))
+          (when (>= year 1969)
+            (setq month (string-to-number (aref vector 1))
+                  day (string-to-number (aref vector 2)))
+            (unless (>= (length (setq time (aref vector 3))) 3)
+              (setq time "00:00:00"))
+            (when (and (setq zone (aref vector 4))
+                       (not (string-match "\\`[A-Z+-]" zone)))
+              (setq zone nil))))
+         ;; ISO 8601
+         ((string-match
+           (eval-when-compile
+             (concat
+              ;; 1. year
+              "\\(199[0-9]\\|20[0-9][0-9]\\)"
+              "\\(?:-"
+              ;; 2. month
+              "\\([01][0-9]\\)"
+              "\\(?:-"
+              ;; 3. day
+              "\\([0-3][0-9]\\)"
+              "\\)?\\)?\\(?:T"
+              ;; 4. hh:mm
+              "\\([012][0-9]:[0-5][0-9]\\)"
+              "\\(?:"
+              ;; 5. :ss
+              "\\(:[0-5][0-9]\\)"
+              "\\(?:\\.[0-9]+\\)?\\)?\\)?"
+              ;; 6+7,8,9. zone
+              "\\(?:\\(?:\\([+-][012][0-9]\\):\\([0-5][0-9]\\)\\)"
+              "\\|\\([+-][012][0-9][0-5][0-9]\\)"
+              "\\|\\(Z\\)\\)?"))
+           date)
+          (setq year (string-to-number (match-string 1 date))
+                month (string-to-number (or (match-string 2 date) "1"))
+                day (string-to-number (or (match-string 3 date) "1"))
+                time (if (match-beginning 5)
+                         (substring date (match-beginning 4) (match-end 5))
+                       (concat (or (match-string 4 date) "00:00") ":00"))
+                zone (cond ((match-beginning 6)
+                            (concat (match-string 6 date)
+                                    (match-string 7 date)))
+                           ((match-beginning 9) ;; Z
+                            "+0000")
+                           (t ;; nil if zone is not provided.
+                            (match-string 8 date))))))
+    (if month
+       (progn
+         (setq cts (current-time-string (encode-time 0 0 0 day month year)))
+         (format "%s, %02d %s %04d %s%s"
+                 (substring cts 0 3) day (substring cts 4 7) year time
+                 (if zone
+                     (concat " " zone)
+                   "")))
+      (message-make-date given))))

 
 ;;; data functions
 
 (defun nnrss-read-server-data (server)
   (setq nnrss-server-data nil)
 
 ;;; 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)
     (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)
 
 (defun nnrss-save-server-data (server)
   (gnus-make-directory nnrss-directory)


@@ -440,17 +542,12 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
   (let ((pair (assoc group nnrss-server-data)))
     (setq nnrss-group-max (or (cadr pair) 0))
     (setq nnrss-group-min (+ nnrss-group-max 1)))
   (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)
     (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)
       (dolist (e nnrss-group-data)

-       (puthash (or (nth 2 e) (nth 6 e)) t nnrss-group-hashtb)
+       (puthash (nth 9 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)))
        (when (and (car e) (> nnrss-group-min (car e)))
          (setq nnrss-group-min (car e)))
        (when (and (car e) (< nnrss-group-max (car e)))


@@ -490,9 +587,13 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
 (defun nnrss-no-cache (url)
   "")
 
 (defun nnrss-no-cache (url)
   "")
 

-(defun nnrss-insert-w3 (url)
+(defun nnrss-insert (url)

   (mm-with-unibyte-current-buffer
   (mm-with-unibyte-current-buffer

-    (mm-url-insert url)))
+    (condition-case err
+       (mm-url-insert url)
+      (error (if (or debug-on-quit debug-on-error)
+                (signal (car err) (cdr err))
+              (message "nnrss: Failed to fetch %s" url))))))

 
 (defun nnrss-decode-entities-string (string)
   (if string
 
 (defun nnrss-decode-entities-string (string)
   (if string


@@ -501,8 +602,6 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
        (mm-url-decode-entities-nbsp)
        (buffer-string))))
 
        (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)
 (defun nnrss-mime-encode-string (string)
   (mm-with-multibyte-buffer
     (insert string)


@@ -521,14 +620,25 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
       (rfc2047-encode-region (point-min) (point-max)))
     (goto-char (point-min))
     (while (search-forward "\n" nil t)
       (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
     (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)
 
 (defun nnrss-check-group (group server)

-  (let (file xml subject url extra changed author date
-            enclosure rss-ns rdf-ns content-ns dc-ns)
+  (let (file xml subject url extra changed author date feed-subject
+            enclosure comments rss-ns rdf-ns content-ns dc-ns
+            hash-index)

     (if (and nnrss-use-local
             (file-exists-p (setq file (expand-file-name
                                        (nnrss-translate-file-chars
     (if (and nnrss-use-local
             (file-exists-p (setq file (expand-file-name
                                        (nnrss-translate-file-chars


@@ -550,9 +660,6 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
            (push (list group nnrss-group-max url) nnrss-server-data)))
        (setq changed t))
       (setq xml (nnrss-fetch url)))
            (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/")
     (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/")


@@ -560,22 +667,22 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
     (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml)))
       (when (and (listp item)
                 (string= (concat rss-ns "item") (car item))
     (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-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))))
+                (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 subject (nnrss-node-text rss-ns 'title item))

-       (setq extra (or extra
-                       (nnrss-node-text content-ns 'encoded item)
+       (setq url (nnrss-decode-entities-string
+                  (nnrss-node-text rss-ns 'link (cddr item))))
+       (setq extra (or (nnrss-node-text content-ns 'encoded item)

                        (nnrss-node-text rss-ns 'description item)))
                        (nnrss-node-text rss-ns 'description item)))

+       (if (setq feed-subject (nnrss-node-text dc-ns 'subject item))
+           (setq extra (concat feed-subject "<br /><br />" extra)))

        (setq author (or (nnrss-node-text rss-ns 'author item)
                         (nnrss-node-text dc-ns 'creator item)
                         (nnrss-node-text dc-ns 'contributor item)))
        (setq author (or (nnrss-node-text rss-ns 'author 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)))
+       (setq date (nnrss-normalize-date
+                   (or (nnrss-node-text dc-ns 'date item)
+                       (nnrss-node-text rss-ns 'pubDate item))))
+       (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)))
        (when (setq enclosure (cadr (assq (intern (concat rss-ns "enclosure")) item)))
          (let ((url (cdr (assq 'url enclosure)))
                (len (cdr (assq 'length enclosure)))


@@ -606,9 +713,11 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
          (and author (nnrss-mime-encode-string author))
          date
          (and extra (nnrss-decode-entities-string extra))
          (and author (nnrss-mime-encode-string author))
          date
          (and extra (nnrss-decode-entities-string extra))

-         enclosure)
+         enclosure
+         comments
+         hash-index)

         nnrss-group-data)
         nnrss-group-data)

-       (puthash (or url extra) t nnrss-group-hashtb)
+       (puthash hash-index t nnrss-group-hashtb)

        (setq changed t))
       (setq extra nil))
     (when changed
        (setq changed t))
       (setq extra nil))
     (when changed


@@ -619,18 +728,35 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
          (push (list group nnrss-group-max) nnrss-server-data)))
       (nnrss-save-server-data server))))
 
          (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."
   (interactive "fImport file: ")
 (defun nnrss-opml-import (opml-file)
   "OPML subscriptions import.
 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)))))
+  (mapc
+   (lambda (node)
+     (let ((xmlurl (cdr (assq 'xmlUrl (cadr node)))))
+       (when (and xmlurl
+                 (not (string-match "\\`[\t ]*\\'" xmlurl))
+                 (prog1
+                     (y-or-n-p (format "Subscribe to %s " xmlurl))
+                   (message "")))
+        (condition-case err
+            (progn
+              (gnus-group-make-rss-group xmlurl)
+              (forward-line 1))
+          (error
+           (message
+            "Failed to subscribe to %s (%s); type any key to continue: "
+            xmlurl
+            (error-message-string err))
+           (let ((echo-keystrokes 0))
+             (read-char)))))))

    (nnrss-find-el 'outline
    (nnrss-find-el 'outline

-                 (progn
-                   (find-file opml-file)
-                   (xml-parse-region (point-min)
-                                     (point-max))))))
+                 (mm-with-multibyte-buffer
+                   (insert-file-contents opml-file)
+                   (xml-parse-region (point-min) (point-max))))))

 
 (defun nnrss-opml-export ()
   "OPML subscription export.
 
 (defun nnrss-opml-export ()
   "OPML subscription export.


@@ -677,33 +803,6 @@ It is useful when `(setq nnrss-use-local t)'."
         (append nnheader-file-name-translation-alist '((?' . ?_)))))
     (nnheader-translate-file-chars name)))
 
         (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-node-text (namespace local-name element)
   (let* ((node (assq (intern (concat namespace (symbol-name local-name)))
                     element))


@@ -767,8 +866,7 @@ Careful with this on large documents!"
 
 (defun nnrss-extract-hrefs (data)
   "Recursively extract hrefs from a page's source.
 
 (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)))
   (mapcar (lambda (ahref)
            (cdr (assoc 'href (cadr ahref))))
          (nnrss-find-el 'a data)))


@@ -820,30 +918,30 @@ whether they are `offsite' or `onsite'."
      rss-offsite-in rdf-offsite-in xml-offsite-in)))
 
 (defun nnrss-discover-feed (url)
      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)))
   (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))
 
     (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)))))
       (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
          (let* ((base-uri (progn (string-match ".*://[^/]+/?" url)
                                  (match-string 0 url)))
                 (hrefs (nnrss-order-hrefs


@@ -856,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)))))
                      (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)
              (nnrss-find-rss-via-syndic8 url))))))))
 
 (defun nnrss-find-rss-via-syndic8 (url)


@@ -904,9 +1002,9 @@ whether they are `offsite' or `onsite'."
                                    (cdr (assoc "feedid" listinfo)))))
                           feedinfo)))
              (cdr (assoc
                                    (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.
 
 (defun nnrss-rss-p (data)
   "Test if DATA is an RSS feed.


@@ -943,7 +1041,4 @@ prefix), return the prefix."
 
 (provide 'nnrss)
 
 
 (provide 'nnrss)
 

-

 ;;; nnrss.el ends here
 ;;; nnrss.el ends here

-
-;;; arch-tag: 12910c07-0cdf-44fb-8d2c-416ded64c267