projects / elisp / gnus.git- / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Synch to No Gnus 200507290604.
[elisp/gnus.git-] / lisp / nnrss.el
diff --git a/lisp/nnrss.el b/lisp/nnrss.el
index cdd4923..0d173a0 100644 (file)
--- a/lisp/nnrss.el
+++ b/lisp/nnrss.el
@@ -18,8 +18,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:
 
@@ -203,54 +203,61 @@ The return value will be `html' or `text'."
        (nntp-server-buffer (or buffer nntp-server-buffer))
        post err)
     (when e
        (nntp-server-buffer (or buffer nntp-server-buffer))
        post err)
     (when e
-      (catch 'error
-       (with-current-buffer nntp-server-buffer
-         (erase-buffer)
-         (if group
-             (mm-with-unibyte-current-buffer
-               (insert "Newsgroups: "
-                       (if (mm-coding-system-p 'utf-8)
-                           (mm-encode-coding-string group 'utf-8)
-                         group)
-                       "\n")))
-         (if (nth 3 e)
-             (insert "Subject: " (nth 3 e) "\n"))
-         (if (nth 4 e)
-             (insert "From: " (nth 4 e) "\n"))
-         (if (nth 5 e)
-             (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
-         (insert (format "Message-ID: <%d@%s.nnrss>\n"
-                         (car e)
-                         (gnus-replace-in-string group "[\t\n ]+" "_")))
-         (insert "\n")
-         (let ((text (if (nth 6 e)
-                         (mapconcat 'identity
-                                    (delete "" (split-string (nth 6 e) "\n+"))
-                                    " ")))
-               (link (nth 2 e))
-               (mail-header-separator "")
-               mime-edit-insert-user-agent-field)
-           (when (or text link)
-             (if (eq 'html (nnrss-body-presentation-method))
-                 (progn
-                   (mime-edit-insert-text "html")
-                   (insert "<html><head></head><body>\n")
-                   (when text
-                     (insert text "\n"))
-                   (when link
-                     (insert "<p><a href=\"" link "\">link</a></p>\n"))
-                   (insert "</body></html>\n"))
-               (mime-edit-insert-text "plain")
-               (if text
-                   (progn
-                     (insert text "\n")
-                     (when link
-                       (insert "\n" link "\n")))
+      (with-current-buffer nntp-server-buffer
+       (erase-buffer)
+       (if group
+           (mm-with-unibyte-current-buffer
+             (insert "Newsgroups: "
+                     (if (mm-coding-system-p 'utf-8)
+                         (mm-encode-coding-string group 'utf-8)
+                       group)
+                     "\n")))
+       (if (nth 3 e)
+           (insert "Subject: " (nth 3 e) "\n"))
+       (if (nth 4 e)
+           (insert "From: " (nth 4 e) "\n"))
+       (if (nth 5 e)
+           (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
+       (insert (format "Message-ID: <%d@%s.nnrss>\n"
+                       (car e)
+                       (gnus-replace-in-string group "[\t\n ]+" "_")))
+       (insert "\n")
+       (let ((text (if (nth 6 e)
+                       (mapconcat 'identity
+                                  (delete "" (split-string (nth 6 e) "\n+"))
+                                  " ")))
+             (link (nth 2 e))
+             (enclosure (nth 7 e))
+             (mail-header-separator "")
+             mime-edit-insert-user-agent-field)
+         (when (or text link enclosure)
+           (if (eq 'html (nnrss-body-presentation-method))
+               (progn
+                 (mime-edit-insert-text "html")
+                 (insert "<html><head></head><body>\n")
+                 (when text
+                   (insert text "\n"))
                  (when link
                  (when link
-                   (insert link "\n"))))
-             (mime-edit-translate-body)))
-         (when nnrss-content-function
-           (funcall nnrss-content-function e group article)))))
+                   (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"))
+                 (insert "</body></html>\n"))
+             (mime-edit-insert-text "plain")
+             (when text
+               (insert text "\n")
+               (when (or link enclosure)
+                 (insert "\n")))
+             (when link
+               (insert link "\n"))
+             (when enclosure
+               (insert (car enclosure) " "
+                       (nth 2 enclosure) " "
+                       (nth 3 enclosure) "\n")))
+           (mime-edit-translate-body)))
+       (when nnrss-content-function
+         (funcall nnrss-content-function e group article))))
     (cond
      (err
       (nnheader-report 'nnrss err))
     (cond
      (err
       (nnheader-report 'nnrss err))
@@ -520,8 +527,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
+            enclosure 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
@@ -569,6 +576,27 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
        (setq date (or (nnrss-node-text dc-ns 'date item)
                       (nnrss-node-text rss-ns 'pubDate item)
                       (message-make-date)))
        (setq date (or (nnrss-node-text dc-ns 'date item)
                       (nnrss-node-text rss-ns 'pubDate item)
                       (message-make-date)))
+       (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)
@@ -577,7 +605,8 @@ 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)
         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))
@@ -620,10 +649,9 @@ Export subscriptions to a buffer in OPML Format."
            "    <ownerName>" (user-full-name) "</ownerName>\n"
            "  </head>\n"
            "  <body>\n")
            "    <ownerName>" (user-full-name) "</ownerName>\n"
            "  </head>\n"
            "  <body>\n")
-    (mapc (lambda (sub)
-           (insert "    <outline text=\"" (car sub) "\" xmlUrl=\""
-                   (cadr sub) "\"/>\n"))
-         nnrss-group-alist)
+    (dolist (sub nnrss-group-alist)
+      (insert "    <outline text=\"" (car sub)
+             "\" xmlUrl=\"" (cadr sub) "\"/>\n"))
     (insert "  </body>\n"
            "</opml>\n"))
   (pop-to-buffer "*OPML Export*")
     (insert "  </body>\n"
            "</opml>\n"))
   (pop-to-buffer "*OPML Export*")
@@ -682,8 +710,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)))
@@ -697,27 +728,26 @@ It is useful when `(setq nnrss-use-local t)'."
   "Find the all matching elements in the data.
 Careful with this on large documents!"
   (when (consp data)
   "Find the all matching elements in the data.
 Careful with this on large documents!"
   (when (consp data)
-    (mapc (lambda (bit)
-           (when (car-safe bit)
-             (when (equal tag (car bit))
-               ;; Old xml.el may return a list of string.
-               (when (and (consp (caddr bit))
-                          (stringp (caaddr bit)))
-                 (setcar (cddr bit) (caaddr bit)))
-               (setq found-list
-                     (append found-list
-                             (list bit))))
-             (if (and (consp (car-safe (caddr bit)))
-                      (not (stringp (caddr bit))))
-                 (setq found-list
-                       (append found-list
-                               (nnrss-find-el
-                                tag (caddr bit))))
-               (setq found-list
-                     (append found-list
-                             (nnrss-find-el
-                              tag (cddr bit)))))))
-         data))
+    (dolist (bit data)
+      (when (car-safe bit)
+       (when (equal tag (car bit))
+         ;; Old xml.el may return a list of string.
+         (when (and (consp (caddr bit))
+                    (stringp (caaddr bit)))
+           (setcar (cddr bit) (caaddr bit)))
+         (setq found-list
+               (append found-list
+                       (list bit))))
+       (if (and (consp (car-safe (caddr bit)))
+                (not (stringp (caddr bit))))
+           (setq found-list
+                 (append found-list
+                         (nnrss-find-el
+                          tag (caddr bit))))
+         (setq found-list
+               (append found-list
+                       (nnrss-find-el
+                        tag (cddr bit))))))))
   found-list)
 
 (defun nnrss-rsslink-p (el)
   found-list)
 
 (defun nnrss-rsslink-p (el)
@@ -763,27 +793,26 @@ whether they are `offsite' or `onsite'."
        rss-onsite-in   rdf-onsite-in   xml-onsite-in
        rss-offsite-end rdf-offsite-end xml-offsite-end
        rss-offsite-in rdf-offsite-in xml-offsite-in)
        rss-onsite-in   rdf-onsite-in   xml-onsite-in
        rss-offsite-end rdf-offsite-end xml-offsite-end
        rss-offsite-in rdf-offsite-in xml-offsite-in)
-    (mapc (lambda (href)
-           (if (not (null href))
-               (cond ((string-match "\\.rss$" href)
-                      (nnrss-match-macro
-                       base-uri href rss-onsite-end rss-offsite-end))
-                     ((string-match "\\.rdf$" href)
-                      (nnrss-match-macro
-                       base-uri href rdf-onsite-end rdf-offsite-end))
-                     ((string-match "\\.xml$" href)
-                      (nnrss-match-macro
-                       base-uri href xml-onsite-end xml-offsite-end))
-                     ((string-match "rss" href)
-                      (nnrss-match-macro
-                       base-uri href rss-onsite-in rss-offsite-in))
-                     ((string-match "rdf" href)
-                      (nnrss-match-macro
-                       base-uri href rdf-onsite-in rdf-offsite-in))
-                     ((string-match "xml" href)
-                      (nnrss-match-macro
-                       base-uri href xml-onsite-in xml-offsite-in)))))
-         hrefs)
+    (dolist (href hrefs)
+      (cond ((null href))
+           ((string-match "\\.rss$" href)
+            (nnrss-match-macro
+             base-uri href rss-onsite-end rss-offsite-end))
+           ((string-match "\\.rdf$" href)
+            (nnrss-match-macro
+             base-uri href rdf-onsite-end rdf-offsite-end))
+           ((string-match "\\.xml$" href)
+            (nnrss-match-macro
+             base-uri href xml-onsite-end xml-offsite-end))
+           ((string-match "rss" href)
+            (nnrss-match-macro
+             base-uri href rss-onsite-in rss-offsite-in))
+           ((string-match "rdf" href)
+            (nnrss-match-macro
+             base-uri href rdf-onsite-in rdf-offsite-in))
+           ((string-match "xml" href)
+            (nnrss-match-macro
+             base-uri href xml-onsite-in xml-offsite-in))))
     (append
      rss-onsite-end  rdf-onsite-end  xml-onsite-end
      rss-onsite-in   rdf-onsite-in   xml-onsite-in
     (append
      rss-onsite-end  rdf-onsite-end  xml-onsite-end
      rss-onsite-in   rdf-onsite-in   xml-onsite-in
@@ -871,7 +900,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