X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnrss.el;h=0d173a00b5b366e588c561334b08c7daec088bb8;hb=27688c4fe73986a46e3f2cb9051170f41ef82f4c;hp=cdd49232cd9bbbf6175eea0797dfd8fec1ca9f53;hpb=09b069582acdc0e0d4d286e55767b65e0dae83aa;p=elisp%2Fgnus.git- diff --git a/lisp/nnrss.el b/lisp/nnrss.el index cdd4923..0d173a0 100644 --- 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 -;; 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: @@ -203,54 +203,61 @@ The return value will be `html' or `text'." (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 "\n") - (when text - (insert text "\n")) - (when link - (insert "

\n")) - (insert "\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 "\n") + (when text + (insert text "\n")) (when link - (insert link "\n")))) - (mime-edit-translate-body))) - (when nnrss-content-function - (funcall nnrss-content-function e group article))))) + (insert "

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

" + (cadr enclosure) " " (nth 2 enclosure) + " " (nth 3 enclosure) "

\n")) + (insert "\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)) @@ -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) - (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 @@ -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))) + (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) @@ -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 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)) @@ -620,10 +649,9 @@ Export subscriptions to a buffer in OPML Format." " " (user-full-name) "\n" " \n" " \n") - (mapc (lambda (sub) - (insert " \n")) - nnrss-group-alist) + (dolist (sub nnrss-group-alist) + (insert " \n")) (insert " \n" "\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)) - (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))) @@ -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) - (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) @@ -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) - (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 @@ -871,7 +900,7 @@ whether they are `offsite' or `onsite'." (selection (mapcar (lambda (listinfo) (cons (cdr (assoc "sitename" listinfo)) - (string-to-int + (string-to-number (cdr (assoc "feedid" listinfo))))) feedinfo))) (cdr (assoc