Use .invalid.

[gnus] / lisp / nnrss.el

diff --git a/lisp/nnrss.el b/lisp/nnrss.el
index 2522b71..f405687 100644 (file)
--- a/lisp/nnrss.el
+++ b/lisp/nnrss.el
@@ -1,5 +1,7 @@
 ;;; nnrss.el --- interfacing with RSS
 ;;; nnrss.el --- interfacing with RSS

-;; Copyright (C) 2001, 2002, 2003, 2004, 2005  Free Software Foundation, Inc.
+
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
+;;   2006 Free Software Foundation, Inc.

 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: RSS
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: RSS


@@ -18,8 +20,8 @@
 
 ;; 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
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -86,9 +88,14 @@ ARTICLE is the article number of the current headline.")
 (defvar nnrss-compatible-encoding-alist '((iso-8859-1 . windows-1252))
   "Alist of encodings and those supersets.
 The cdr of each element is used to decode data if it is available when
 (defvar nnrss-compatible-encoding-alist '((iso-8859-1 . windows-1252))
   "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.")
 
 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
 (nnoo-define-basics nnrss)
 
 ;;; Interface functions


@@ -168,6 +175,10 @@ for decoding when the cdr that the data specify is not available.")
 (deffoo nnrss-close-group (group &optional server)
   t)
 
 (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)
 (deffoo nnrss-request-article (article &optional group server buffer)
   (setq group (nnrss-decode-group-name group))
   (when (stringp article)


@@ -190,11 +201,10 @@ 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))
              (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
              ;; Enable encoding of Newsgroups header in XEmacs.
              (default-enable-multibyte-characters t)
              (rfc2047-header-encoding-alist


@@ -202,19 +212,65 @@ for decoding when the cdr that the data specify is not available.")
                   (cons '("Newsgroups" . utf-8)
                         rfc2047-header-encoding-alist)
                 rfc2047-header-encoding-alist))
                   (cons '("Newsgroups" . utf-8)
                         rfc2047-header-encoding-alist)
                 rfc2047-header-encoding-alist))

-             rfc2047-encode-encoded-words body)
-         (when (or text link)
+             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))
            (insert "\n")
            (insert "<#multipart type=alternative>\n"
                    "<#part type=\"text/plain\">\n")
            (setq body (point))

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


@@ -223,6 +279,12 @@ for decoding when the cdr that the data specify is not available.")
              (insert text "\n"))
            (when link
              (insert "<p><a href=\"" link "\">link</a></p>\n"))
              (insert text "\n"))
            (when link
              (insert "<p><a href=\"" link "\">link</a></p>\n"))

+           (when enclosure
+             (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"))
            (insert "</body></html>\n"
                    "<#/part>\n"
                    "<#/multipart>\n"))


@@ -348,7 +410,11 @@ 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))


@@ -399,6 +465,74 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
       (unless (assoc (car elem) nnrss-group-alist)
        (insert (prin1-to-string (car elem)) " 0 1 y\n")))))
 
       (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"))
+
+(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)
+    (cond ((null 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))))
+

 ;;; data functions
 
 (defun nnrss-read-server-data (server)
 ;;; data functions
 
 (defun nnrss-read-server-data (server)


@@ -484,7 +618,11 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
 
 (defun nnrss-insert-w3 (url)
   (mm-with-unibyte-current-buffer
 
 (defun nnrss-insert-w3 (url)
   (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


@@ -519,8 +657,8 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
 ;;; Snarf functions
 
 (defun nnrss-check-group (group server)
 ;;; Snarf functions
 
 (defun nnrss-check-group (group server)

-  (let (file xml subject url extra changed author
-            date 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)

     (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


@@ -562,12 +700,36 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
        (setq extra (or extra
                        (nnrss-node-text content-ns 'encoded item)
                        (nnrss-node-text rss-ns 'description item)))
        (setq extra (or extra
                        (nnrss-node-text content-ns 'encoded 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)))
+               (type (cdr (assq 'type enclosure)))
+               (name))
+           (setq len
+                 (if (and len (integerp (setq len (string-to-number len))))
+                     ;; actually already in `ls-lisp-format-file-size' but
+                     ;; probably not worth to require it for one function
+                     (do ((size (/ len 1.0) (/ size 1024.0))
+                          (post-fixes (list "" "k" "M" "G" "T" "P" "E")
+                                      (cdr post-fixes)))
+                         ((< size 1024)
+                          (format "%.1f%s" size (car post-fixes))))
+                   "0"))
+           (setq url (or url ""))
+           (setq name (if (string-match "/\\([^/]*\\)$" url)
+                          (match-string 1 url)
+                        "file"))
+           (setq type (or type ""))
+           (setq enclosure (list url name len type))))

        (push
         (list
          (incf nnrss-group-max)
        (push
         (list
          (incf nnrss-group-max)


@@ -576,7 +738,9 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
          (and subject (nnrss-mime-encode-string subject))
          (and author (nnrss-mime-encode-string author))
          date
          (and subject (nnrss-mime-encode-string subject))
          (and author (nnrss-mime-encode-string author))
          date

-         (and extra (nnrss-decode-entities-string extra)))
+         (and extra (nnrss-decode-entities-string extra))
+         enclosure
+         comments)

         nnrss-group-data)
        (puthash (or url extra) t nnrss-group-hashtb)
        (setq changed t))
         nnrss-group-data)
        (puthash (or url extra) t nnrss-group-hashtb)
        (setq changed t))


@@ -593,14 +757,29 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
   "OPML subscriptions import.
 Read the file and attempt to subscribe to each Feed in the file."
   (interactive "fImport 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.


@@ -680,8 +859,11 @@ It is useful when `(setq nnrss-use-local t)'."
         (text (if (and node (listp node))
                   (nnrss-node-just-text node)
                 node))
         (text (if (and node (listp node))
                   (nnrss-node-just-text node)
                 node))

-        (cleaned-text (if text (gnus-replace-in-string
-                                text "^[\000-\037\177]+\\|^ +\\| +$" ""))))
+        (cleaned-text (if text
+                          (gnus-replace-in-string
+                           (gnus-replace-in-string
+                            text "^[\000-\037\177]+\\|^ +\\| +$" "")
+                           "\r\n" "\n"))))

     (if (string-equal "" cleaned-text)
        nil
       cleaned-text)))
     (if (string-equal "" cleaned-text)
        nil
       cleaned-text)))


@@ -867,7 +1049,7 @@ whether they are `offsite' or `onsite'."
                  (selection
                   (mapcar (lambda (listinfo)
                             (cons (cdr (assoc "sitename" listinfo))
                  (selection
                   (mapcar (lambda (listinfo)
                             (cons (cdr (assoc "sitename" listinfo))

-                                  (string-to-int
+                                  (string-to-number

                                    (cdr (assoc "feedid" listinfo)))))
                           feedinfo)))
              (cdr (assoc
                                    (cdr (assoc "feedid" listinfo)))))
                           feedinfo)))
              (cdr (assoc