X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnrss.el;h=0d173a00b5b366e588c561334b08c7daec088bb8;hb=27688c4fe73986a46e3f2cb9051170f41ef82f4c;hp=211ca3ec07a308f3ff57c171736e7d25feec4848;hpb=1c657e802036c760bb3e59477f1410f6ae043309;p=elisp%2Fgnus.git- diff --git a/lisp/nnrss.el b/lisp/nnrss.el index 211ca3e..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: @@ -41,7 +41,7 @@ (require 'mime-view) (eval-when-compile (ignore-errors - (require 'xml))) + (require 'xml))) (eval '(require 'xml)) ;; Reload mm-util emulating macros for compiling. @@ -89,6 +89,12 @@ ARTICLE is the article number of the current headline.") (defvar nnrss-file-coding-system nnheader-auto-save-coding-system "Coding system used when reading and writing files.") +(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 +for decoding when the cdr that the data specify is not available.") + (nnoo-define-basics nnrss) ;;; Interface functions @@ -152,15 +158,18 @@ ARTICLE is the article number of the current headline.") (deffoo nnrss-request-group (group &optional server dont-check) (setq group (nnrss-decode-group-name group)) + (nnheader-message 6 "nnrss: Requesting %s..." group) (nnrss-possibly-change-group group server) - (if dont-check - t - (nnrss-check-group group server) - (nnheader-report 'nnrss "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max - (prin1-to-string group) - t))) + (prog1 + (if dont-check + t + (nnrss-check-group group server) + (nnheader-report 'nnrss "Opened group %s" group) + (nnheader-insert + "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max + (prin1-to-string group) + t)) + (nnheader-message 6 "nnrss: Requesting %s...done" group))) (deffoo nnrss-close-group (group &optional server) t) @@ -194,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)) @@ -293,7 +309,7 @@ The return value will be `html' or `text'." (delq (assoc group nnrss-server-data) nnrss-server-data)) (nnrss-save-server-data server) (ignore-errors - (delete-file (nnrss-make-filename group server))) + (delete-file (nnrss-make-filename group server))) t) (deffoo nnrss-request-list-newsgroups (&optional server) @@ -312,16 +328,24 @@ The return value will be `html' or `text'." (eval-when-compile (defun xml-rpc-method-call (&rest args))) (defun nnrss-get-encoding () - "Return an encoding attribute specified in the current xml contents." + "Return an encoding attribute specified in the current xml contents. +If `nnrss-compatible-encoding-alist' specifies the compatible encoding, +it is used instead. If the xml contents doesn't specify the encoding, +return `utf-8' which is the default encoding for xml if it is available, +otherwise return nil." (goto-char (point-min)) - (mm-coding-system-p - (if (re-search-forward - "<\\?[^>]*encoding=\\(?:\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)" - nil t) - (intern-soft (downcase (or (match-string-no-properties 1) - (match-string-no-properties 2)))) - ;; The default encoding for xml. - 'utf-8))) + (if (re-search-forward + "<\\?[^>]*encoding=\\(?:\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)" + nil t) + (let ((encoding (intern (downcase (or (match-string 1) + (match-string 2)))))) + (or + (mm-coding-system-p (cdr (assq encoding + nnrss-compatible-encoding-alist))) + (mm-coding-system-p encoding) + (mm-coding-system-p (car (rassq encoding + nnrss-compatible-encoding-alist))))) + (mm-coding-system-p 'utf-8))) (defun nnrss-fetch (url &optional local) "Fetch URL and put it in a the expected Lisp structure." @@ -503,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 @@ -515,11 +539,11 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s" (second (assoc group nnrss-group-alist)))) (unless url (setq url - (cdr - (assoc 'href - (nnrss-discover-feed - (read-string - (format "URL to search for %s: " group) "http://"))))) + (cdr + (assoc 'href + (nnrss-discover-feed + (read-string + (format "URL to search for %s: " group) "http://"))))) (let ((pair (assoc group nnrss-server-data))) (if pair (setcdr (cdr pair) (list url)) @@ -552,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) @@ -560,11 +605,12 @@ 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)) - (setq extra nil)) + (setq extra nil)) (when changed (nnrss-save-group-data group server) (let ((pair (assoc group nnrss-server-data))) @@ -579,12 +625,12 @@ 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))))) + (cdr (assq 'xmlUrl (cadr node))))) (nnrss-find-el 'outline - (progn - (find-file opml-file) - (xml-parse-region (point-min) - (point-max)))))) + (progn + (find-file opml-file) + (xml-parse-region (point-min) + (point-max)))))) (defun nnrss-opml-export () "OPML subscription export. @@ -592,26 +638,22 @@ Export subscriptions to a buffer in OPML Format." (interactive) (with-current-buffer (get-buffer-create "*OPML Export*") (mm-set-buffer-file-coding-system 'utf-8) - (insert (concat - "\n" - "\n" - "