Mercurial > emacs
changeset 61424:ad05d91d3598
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-243
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 59)
- Update from CVS
2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/calendar/time-date.el (time-to-seconds): Don't use the #xhhhh
syntax which Emacs 20 doesn't support.
(seconds-to-time, days-to-time, time-subtract, time-add): Ditto.
2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/mm-util.el (mm-coding-system-p): Don't return binary for the nil
argument in XEmacs.
* lisp/gnus/nnrss.el (nnrss-compatible-encoding-alist): New variable.
(nnrss-request-group): Decode group name first.
(nnrss-request-article): Make a text/plain article if mml-to-mime
failed.
(nnrss-get-encoding): Return a compatible encoding according to
nnrss-compatible-encoding-alist.
(nnrss-opml-export): Use dolist.
(nnrss-find-el): Use consp instead of listp.
(nnrss-order-hrefs): Use dolist.
2005-04-06 Arne J,Ax(Brgensen <arne@arnested.dk>
* lisp/gnus/nnrss.el (nnrss-verbose): Remove.
(nnrss-request-group): Use `nnheader-message' instead.
2005-04-06 Mark Plaksin <happy@usg.edu> (tiny change)
* lisp/gnus/nnrss.el (nnrss-verbose): New variable.
(nnrss-request-group): Make it say nnrss is requesting a group.
2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/gnus-agent.el (gnus-agent-group-path): Decode group name.
(gnus-agent-group-pathname): Ditto.
* lisp/gnus/gnus-cache.el (gnus-cache-file-name): Decode group name.
* lisp/gnus/gnus-group.el (gnus-group-line-format-alist): Use decoded group
name for only %g and %c.
(gnus-group-insert-group-line): Bind gnus-tmp-decoded-group
instead of gnus-tmp-group to decoded group name.
(gnus-group-make-group): Decode group name.
(gnus-group-delete-group): Ditto.
(gnus-group-make-rss-group): Exclude `/'s from group names;
register the group data after opening the nnrss group; unify
non-ASCII group names; encode group name.
(gnus-group-catchup-current): Decode group name.
(gnus-group-expire-articles-1): Ditto.
(gnus-group-set-current-level): Ditto.
(gnus-group-kill-group): Ditto.
* lisp/gnus/gnus-spec.el (gnus-update-format-specifications): Flush the
group format spec cache if it doesn't support decoded group names.
* lisp/gnus/mm-url.el (mm-url-predefined-programs): Add --silent arg to curl.
* lisp/gnus/nnrss.el: Require rfc2047 and mml.
(nnrss-file-coding-system): New variable.
(nnrss-format-string): Redefine it as an inline function.
(nnrss-decode-group-name): New function.
(nnrss-string-as-multibyte): Remove.
(nnrss-retrieve-headers): Decode group name; don't use
nnrss-format-string.
(nnrss-request-group): Decode group name.
(nnrss-request-article): Decode group name; allow a Message-ID as
well as an article number; don't use nnrss-format-string; encode a
Message-ID string which may contain non-ASCII characters; use
mml-to-mime to compose a MIME article; use search-forward instead
of re-search-forward.
(nnrss-request-expire-articles): Decode group name.
(nnrss-request-delete-group): Delete entries in nnrss-group-alist
as well; decode group name.
(nnrss-get-encoding): Fix regexp.
(nnrss-fetch): Clarify error message.
(nnrss-read-server-data): Use insert-file-contents instead of load;
bind file-name-coding-system; use multibyte buffer.
(nnrss-save-server-data): Insert newline; bind
coding-system-for-write to the value of nnrss-file-coding-system;
bind file-name-coding-system; add coding cookie.
(nnrss-read-group-data): Use insert-file-contents instead of load;
bind file-name-coding-system; use multibyte buffer.
(nnrss-save-group-data): Bind coding-system-for-write to the
value of nnrss-file-coding-system; bind file-name-coding-system.
(nnrss-decode-entities-string): Rename from n-d-e-unibyte-string;
make it work with non-ASCII text.
(nnrss-opml-export): Use mm-set-buffer-file-coding-system instead
of set-buffer-file-coding-system.
(nnrss-find-el): Check carefully whether there's a list of string
which old xml.el may return rather than a string; make it work
with old xml.el as well.
2005-04-06 Tsuyoshi AKIHO <akiho@kawachi.zaq.ne.jp>
* lisp/gnus/gnus-sum.el (gnus-summary-walk-group-buffer): Decode group name.
* lisp/gnus/nnrss.el (nnrss-get-encoding): New function.
(nnrss-fetch): Use unibyte buffer initially; bind
coding-system-for-read while performing mm-url-insert; remove ^Ms;
decode contents according to the encoding attribute.
(nnrss-save-group-data): Add coding cookie.
(nnrss-mime-encode-string): New function.
(nnrss-check-group): Use it to encode subject and author.
2005-04-06 Maciek Pasternacki <maciekp@japhy.fnord.org> (tiny change)
* lisp/gnus/nnrss.el (nnrss-fetch): Signal an error if w3-parse-buffer also
failed.
2005-04-06 Jesper Harder <harder@ifa.au.dk>
* lisp/gnus/mm-util.el (mm-subst-char-in-string): Support inplace.
* lisp/gnus/nnrss.el: Pedantic docstring and whitespace fixes (courtesy of
checkdoc.el).
(nnrss-request-article): Cleanup.
(nnrss-request-delete-group): Use nnrss-make-filename.
(nnrss-read-server-data): Use nnrss-make-filename; use load.
(nnrss-save-server-data): Use nnrss-make-filename; use gnus-prin1.
(nnrss-read-group-data): Fix off-by-one error. From Joakim Verona
<joakim@verona.se>; hash on description if link is missing; use
nnrss-make-filename; use load.
(nnrss-save-group-data): Use nnrss-make-filename; use gnus-prin1.
(nnrss-make-filename): New function.
(nnrss-close): New function.
(nnrss-check-group): Hash on description if link is missing.
(nnrss-get-namespace-prefix): Use string= to compare strings!
Reported by David D. Smith <davidsmith@acm.org>.
(nnrss-opml-export): Turn on sgml-mode.
2005-04-06 Mark A. Hershberger <mah@everybody.org>
* lisp/gnus/nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions.
2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (RSS): Addition.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 10 Apr 2005 04:20:14 +0000 |
parents | f2d616f518a5 |
children | 6dfecf2a19ab |
files | lisp/ChangeLog lisp/calendar/time-date.el lisp/gnus/ChangeLog lisp/gnus/gnus-agent.el lisp/gnus/gnus-cache.el lisp/gnus/gnus-group.el lisp/gnus/gnus-spec.el lisp/gnus/gnus-sum.el lisp/gnus/mm-url.el lisp/gnus/mm-util.el lisp/gnus/nnrss.el man/ChangeLog man/gnus.texi |
diffstat | 13 files changed, 671 insertions(+), 319 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/ChangeLog Sun Apr 10 04:20:14 2005 +0000 @@ -1,3 +1,9 @@ +2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * calendar/time-date.el (time-to-seconds): Don't use the #xhhhh + syntax which Emacs 20 doesn't support. + (seconds-to-time, days-to-time, time-subtract, time-add): Ditto. + 2005-04-09 Stefan Monnier <monnier@iro.umontreal.ca> * arc-mode.el (archive-mode-map): Move initialization into
--- a/lisp/calendar/time-date.el Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/calendar/time-date.el Sun Apr 10 04:20:14 2005 +0000 @@ -1,5 +1,6 @@ ;;; time-date.el --- Date and time handling functions -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2004, 2005 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Masanobu Umeda <umerin@mse.kyutech.ac.jp> @@ -112,15 +113,15 @@ "Convert time value TIME to a floating point number. You can use `float-time' instead." (with-decoded-time-value ((high low micro time)) - (+ (* 1.0 high #x10000) + (+ (* 1.0 high 65536) low (/ micro 1000000.0)))) ;;;###autoload (defun seconds-to-time (seconds) "Convert SECONDS (a floating point number) to a time value." - (list (floor seconds #x10000) - (floor (mod seconds #x10000)) + (list (floor seconds 65536) + (floor (mod seconds 65536)) (floor (* (- seconds (ffloor seconds)) 1000000)))) ;;;###autoload @@ -138,10 +139,10 @@ (defun days-to-time (days) "Convert DAYS into a time value." (let* ((seconds (* 1.0 days 60 60 24)) - (high (condition-case nil (floor (/ seconds #x10000)) + (high (condition-case nil (floor (/ seconds 65536)) (range-error most-positive-fixnum)))) - (list high (condition-case nil (floor (- seconds (* 1.0 high #x10000))) - (range-error #xffff))))) + (list high (condition-case nil (floor (- seconds (* 1.0 high 65536))) + (range-error 65535))))) ;;;###autoload (defun time-since (time) @@ -170,7 +171,7 @@ micro (+ micro 1000000))) (when (< low 0) (setq high (1- high) - low (+ low #x10000))) + low (+ low 65536))) (encode-time-value high low micro type))) ;;;###autoload @@ -185,9 +186,9 @@ (when (>= micro 1000000) (setq low (1+ low) micro (- micro 1000000))) - (when (>= low #x10000) + (when (>= low 65536) (setq high (1+ high) - low (- low #x10000))) + low (- low 65536))) (encode-time-value high low micro type))) ;;;###autoload
--- a/lisp/gnus/ChangeLog Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/gnus/ChangeLog Sun Apr 10 04:20:14 2005 +0000 @@ -1,3 +1,131 @@ +2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-util.el (mm-coding-system-p): Don't return binary for the nil + argument in XEmacs. + + * nnrss.el (nnrss-compatible-encoding-alist): New variable. + (nnrss-request-group): Decode group name first. + (nnrss-request-article): Make a text/plain article if mml-to-mime + failed. + (nnrss-get-encoding): Return a compatible encoding according to + nnrss-compatible-encoding-alist. + (nnrss-opml-export): Use dolist. + (nnrss-find-el): Use consp instead of listp. + (nnrss-order-hrefs): Use dolist. + +2005-04-06 Arne J,Ax(Brgensen <arne@arnested.dk> + + * nnrss.el (nnrss-verbose): Remove. + (nnrss-request-group): Use `nnheader-message' instead. + +2005-04-06 Mark Plaksin <happy@usg.edu> (tiny change) + + * nnrss.el (nnrss-verbose): New variable. + (nnrss-request-group): Make it say nnrss is requesting a group. + +2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-agent.el (gnus-agent-group-path): Decode group name. + (gnus-agent-group-pathname): Ditto. + + * gnus-cache.el (gnus-cache-file-name): Decode group name. + + * gnus-group.el (gnus-group-line-format-alist): Use decoded group + name for only %g and %c. + (gnus-group-insert-group-line): Bind gnus-tmp-decoded-group + instead of gnus-tmp-group to decoded group name. + (gnus-group-make-group): Decode group name. + (gnus-group-delete-group): Ditto. + (gnus-group-make-rss-group): Exclude `/'s from group names; + register the group data after opening the nnrss group; unify + non-ASCII group names; encode group name. + (gnus-group-catchup-current): Decode group name. + (gnus-group-expire-articles-1): Ditto. + (gnus-group-set-current-level): Ditto. + (gnus-group-kill-group): Ditto. + + * gnus-spec.el (gnus-update-format-specifications): Flush the + group format spec cache if it doesn't support decoded group names. + + * mm-url.el (mm-url-predefined-programs): Add --silent arg to curl. + + * nnrss.el: Require rfc2047 and mml. + (nnrss-file-coding-system): New variable. + (nnrss-format-string): Redefine it as an inline function. + (nnrss-decode-group-name): New function. + (nnrss-string-as-multibyte): Remove. + (nnrss-retrieve-headers): Decode group name; don't use + nnrss-format-string. + (nnrss-request-group): Decode group name. + (nnrss-request-article): Decode group name; allow a Message-ID as + well as an article number; don't use nnrss-format-string; encode a + Message-ID string which may contain non-ASCII characters; use + mml-to-mime to compose a MIME article; use search-forward instead + of re-search-forward. + (nnrss-request-expire-articles): Decode group name. + (nnrss-request-delete-group): Delete entries in nnrss-group-alist + as well; decode group name. + (nnrss-get-encoding): Fix regexp. + (nnrss-fetch): Clarify error message. + (nnrss-read-server-data): Use insert-file-contents instead of load; + bind file-name-coding-system; use multibyte buffer. + (nnrss-save-server-data): Insert newline; bind + coding-system-for-write to the value of nnrss-file-coding-system; + bind file-name-coding-system; add coding cookie. + (nnrss-read-group-data): Use insert-file-contents instead of load; + bind file-name-coding-system; use multibyte buffer. + (nnrss-save-group-data): Bind coding-system-for-write to the + value of nnrss-file-coding-system; bind file-name-coding-system. + (nnrss-decode-entities-string): Rename from n-d-e-unibyte-string; + make it work with non-ASCII text. + (nnrss-opml-export): Use mm-set-buffer-file-coding-system instead + of set-buffer-file-coding-system. + (nnrss-find-el): Check carefully whether there's a list of string + which old xml.el may return rather than a string; make it work + with old xml.el as well. + +2005-04-06 Tsuyoshi AKIHO <akiho@kawachi.zaq.ne.jp> + + * gnus-sum.el (gnus-summary-walk-group-buffer): Decode group name. + + * nnrss.el (nnrss-get-encoding): New function. + (nnrss-fetch): Use unibyte buffer initially; bind + coding-system-for-read while performing mm-url-insert; remove ^Ms; + decode contents according to the encoding attribute. + (nnrss-save-group-data): Add coding cookie. + (nnrss-mime-encode-string): New function. + (nnrss-check-group): Use it to encode subject and author. + +2005-04-06 Maciek Pasternacki <maciekp@japhy.fnord.org> (tiny change) + + * nnrss.el (nnrss-fetch): Signal an error if w3-parse-buffer also + failed. + +2005-04-06 Jesper Harder <harder@ifa.au.dk> + + * mm-util.el (mm-subst-char-in-string): Support inplace. + + * nnrss.el: Pedantic docstring and whitespace fixes (courtesy of + checkdoc.el). + (nnrss-request-article): Cleanup. + (nnrss-request-delete-group): Use nnrss-make-filename. + (nnrss-read-server-data): Use nnrss-make-filename; use load. + (nnrss-save-server-data): Use nnrss-make-filename; use gnus-prin1. + (nnrss-read-group-data): Fix off-by-one error. From Joakim Verona + <joakim@verona.se>; hash on description if link is missing; use + nnrss-make-filename; use load. + (nnrss-save-group-data): Use nnrss-make-filename; use gnus-prin1. + (nnrss-make-filename): New function. + (nnrss-close): New function. + (nnrss-check-group): Hash on description if link is missing. + (nnrss-get-namespace-prefix): Use string= to compare strings! + Reported by David D. Smith <davidsmith@acm.org>. + (nnrss-opml-export): Turn on sgml-mode. + +2005-04-06 Mark A. Hershberger <mah@everybody.org> + + * nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions. + 2005-04-04 Reiner Steib <Reiner.Steib@gmx.de> * message.el (message-make-date): Add defvars in order to silence
--- a/lisp/gnus/gnus-agent.el Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/gnus/gnus-agent.el Sun Apr 10 04:20:14 2005 +0000 @@ -1,5 +1,5 @@ ;;; gnus-agent.el --- unplugged support for Gnus -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -1371,7 +1371,7 @@ (nnheader-translate-file-chars (nnheader-replace-duplicate-chars-in-string (nnheader-replace-chars-in-string - (gnus-group-real-name group) + (gnus-group-real-name (gnus-group-decoded-name group)) ?/ ?_) ?. ?_))) (if (or nnmail-use-long-file-names @@ -1387,8 +1387,10 @@ ;; unplugged. The agent must, therefore, use the same directory ;; while plugged. (let ((gnus-command-method (or gnus-command-method - (gnus-find-method-for-group group)))) - (nnmail-group-pathname (gnus-group-real-name group) (gnus-agent-directory)))) + (gnus-find-method-for-group group)))) + (nnmail-group-pathname (gnus-group-real-name + (gnus-group-decoded-name group)) + (gnus-agent-directory)))) (defun gnus-agent-get-function (method) (if (gnus-online method)
--- a/lisp/gnus/gnus-cache.el Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/gnus/gnus-cache.el Sun Apr 10 04:20:14 2005 +0000 @@ -1,6 +1,6 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 -;; Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -421,6 +421,7 @@ (and (not unread) (not ticked) (not dormant) (memq 'read class)))) (defun gnus-cache-file-name (group article) + (setq group (gnus-group-decoded-name group)) (expand-file-name (if (stringp article) article (int-to-string article)) (file-name-as-directory
--- a/lisp/gnus/gnus-group.el Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/gnus/gnus-group.el Sun Apr 10 04:20:14 2005 +0000 @@ -482,9 +482,15 @@ (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) - (?g gnus-tmp-group ?s) + (?g (if (boundp 'gnus-tmp-decoded-group) + gnus-tmp-decoded-group + gnus-tmp-group) + ?s) (?G gnus-tmp-qualified-group ?s) - (?c (gnus-short-group-name gnus-tmp-group) ?s) + (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group) + gnus-tmp-decoded-group + gnus-tmp-group)) + ?s) (?C gnus-tmp-comment ?s) (?D gnus-tmp-newsgroup-description ?s) (?o gnus-tmp-moderated ?c) @@ -1441,8 +1447,8 @@ (point) (prog1 (1+ (point)) ;; Insert the text. - (let ((gnus-tmp-group (gnus-group-name-decode - gnus-tmp-group group-name-charset))) + (let ((gnus-tmp-decoded-group (gnus-group-name-decode + gnus-tmp-group group-name-charset))) (eval gnus-group-line-format-spec))) `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) gnus-unread ,(if (numberp number) @@ -2244,7 +2250,7 @@ (nname (if method (gnus-group-prefixed-name name meth) name)) backend info) (when (gnus-gethash nname gnus-newsrc-hashtb) - (error "Group %s already exists" nname)) + (error "Group %s already exists" (gnus-group-decoded-name nname))) ;; Subscribe to the new group. (gnus-group-change-level (setq info (list t nname gnus-level-default-subscribed nil nil meth)) @@ -2305,20 +2311,21 @@ (unless (gnus-check-backend-function 'request-delete-group group) (error "This back end does not support group deletion")) (prog1 - (if (and (not no-prompt) - (not (gnus-yes-or-no-p - (format - "Do you really want to delete %s%s? " - group (if force " and all its contents" ""))))) - () ; Whew! - (gnus-message 6 "Deleting group %s..." group) - (if (not (gnus-request-delete-group group force)) - (gnus-error 3 "Couldn't delete group %s" group) - (gnus-message 6 "Deleting group %s...done" group) - (gnus-group-goto-group group) - (gnus-group-kill-group 1 t) - (gnus-sethash group nil gnus-active-hashtb) - t)) + (let ((group-decoded (gnus-group-decoded-name group))) + (if (and (not no-prompt) + (not (gnus-yes-or-no-p + (format + "Do you really want to delete %s%s? " + group-decoded (if force " and all its contents" ""))))) + () ; Whew! + (gnus-message 6 "Deleting group %s..." group-decoded) + (if (not (gnus-request-delete-group group force)) + (gnus-error 3 "Couldn't delete group %s" group-decoded) + (gnus-message 6 "Deleting group %s...done" group-decoded) + (gnus-group-goto-group group) + (gnus-group-kill-group 1 t) + (gnus-sethash group nil gnus-active-hashtb) + t))) (gnus-group-position-point))) (defun gnus-group-rename-group (group new-name) @@ -2588,16 +2595,26 @@ (setq url (read-from-minibuffer "URL to Search for RSS: "))) (let ((feedinfo (nnrss-discover-feed url))) (if feedinfo - (let ((title (read-from-minibuffer "Title: " - (cdr (assoc 'title - feedinfo)))) + (let ((title (gnus-newsgroup-savable-name + (read-from-minibuffer "Title: " + (gnus-newsgroup-savable-name + (or (cdr (assoc 'title + feedinfo)) + ""))))) (desc (read-from-minibuffer "Description: " (cdr (assoc 'description feedinfo)))) - (href (cdr (assoc 'href feedinfo)))) - (push (list title href desc) - nnrss-group-alist) - (gnus-group-make-group title '(nnrss "")) + (href (cdr (assoc 'href feedinfo))) + (encodable (mm-coding-system-p 'utf-8))) + (when encodable + ;; Unify non-ASCII text. + (setq title (mm-decode-coding-string + (mm-encode-coding-string title 'utf-8) 'utf-8))) + (gnus-group-make-group (if encodable + (mm-encode-coding-string title 'utf-8) + title) + '(nnrss "")) + (push (list title href desc) nnrss-group-alist) (nnrss-save-server-data nil)) (error "No feeds found for %s" url)))) @@ -3101,7 +3118,7 @@ "Do you really want to mark all articles in %s as read? " "Mark all unread articles in %s as read? ") (if (= (length groups) 1) - (car groups) + (gnus-group-decoded-name (car groups)) (format "these %d groups" (length groups))))))) n (while (setq group (pop groups)) @@ -3179,7 +3196,8 @@ (defun gnus-group-expire-articles-1 (group) (when (gnus-check-backend-function 'request-expire-articles group) - (gnus-message 6 "Expiring articles in %s..." group) + (gnus-message 6 "Expiring articles in %s..." + (gnus-group-decoded-name group)) (let* ((info (gnus-get-info group)) (expirable (if (gnus-group-total-expirable-p group) (cons nil (gnus-list-of-read-articles group)) @@ -3204,7 +3222,8 @@ (gnus-request-expire-articles (gnus-uncompress-sequence (cdr expirable)) group)))) (gnus-close-group group)) - (gnus-message 6 "Expiring articles in %s...done" group) + (gnus-message 6 "Expiring articles in %s...done" + (gnus-group-decoded-name group)) ;; Return the list of un-expired articles. (cdr expirable)))) @@ -3243,7 +3262,8 @@ (while (setq group (pop groups)) (gnus-group-remove-mark group) (gnus-message 6 "Changed level of %s from %d to %d" - group (or (gnus-group-group-level) gnus-level-killed) + (gnus-group-decoded-name group) + (or (gnus-group-group-level) gnus-level-killed) level) (gnus-group-change-level group level (or (gnus-group-group-level) gnus-level-killed)) @@ -3392,7 +3412,7 @@ gnus-list-of-killed-groups)) (gnus-group-change-level (if entry entry group) gnus-level-killed (if entry nil level)) - (message "Killed group %s" group)) + (message "Killed group %s" (gnus-group-decoded-name group))) ;; If there are lots and lots of groups to be killed, we use ;; this thing instead. (dolist (group (nreverse groups))
--- a/lisp/gnus/gnus-spec.el Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/gnus/gnus-spec.el Sun Apr 10 04:20:14 2005 +0000 @@ -1,5 +1,5 @@ ;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -196,6 +196,13 @@ (not (equal emacs-version (cdr (assq 'version gnus-format-specs))))) (setq gnus-format-specs nil)) + ;; Flush the group format spec cache if it doesn't support decoded + ;; group names. + (when (memq 'group types) + (let ((spec (assq 'group gnus-format-specs))) + (unless (string-match " gnus-tmp-decoded-group[ )]" + (gnus-prin1-to-string (nth 2 spec))) + (setq gnus-format-specs (delq spec gnus-format-specs))))) ;; Go through all the formats and see whether they need updating. (let (new-format entry type val updated)
--- a/lisp/gnus/gnus-sum.el Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/gnus/gnus-sum.el Sun Apr 10 04:20:14 2005 +0000 @@ -7254,11 +7254,12 @@ (if (and group (not (gnus-ephemeral-group-p gnus-newsgroup-name))) (format " (Type %s for %s [%s])" - (single-key-description cmd) group + (single-key-description cmd) + (gnus-group-decoded-name group) (car (gnus-gethash group gnus-newsrc-hashtb))) (format " (Type %s to exit %s)" (single-key-description cmd) - gnus-newsgroup-name)))) + (gnus-group-decoded-name gnus-newsgroup-name))))) ;; Confirm auto selection. (setq key (car (setq keve (gnus-read-event-char prompt))) ended t)
--- a/lisp/gnus/mm-url.el Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/gnus/mm-url.el Sun Apr 10 04:20:14 2005 +0000 @@ -59,7 +59,7 @@ '((wget "wget" "--user-agent=mm-url" "-q" "-O" "-") (w3m "w3m" "-dump_source") (lynx "lynx" "-source") - (curl "curl"))) + (curl "curl" "--silent"))) (defcustom mm-url-program (cond
--- a/lisp/gnus/mm-util.el Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/gnus/mm-util.el Sun Apr 10 04:20:14 2005 +0000 @@ -57,9 +57,11 @@ mm-mime-mule-charset-alist) nil t)))) (subst-char-in-string - . (lambda (from to string) ;; stolen (and renamed) from nnheader.el - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. + . (lambda (from to string &optional inplace) + ;; stolen (and renamed) from nnheader.el + "Replace characters in STRING from FROM to TO. + Unless optional argument INPLACE is non-nil, return a new string." + (let ((string (if inplace string (copy-sequence string))) (len (length string)) (idx 0)) ;; Replace all occurrences of FROM with TO. @@ -153,7 +155,7 @@ If CS is available, return CS itself in Emacs, and return a coding system object in XEmacs." (if (fboundp 'find-coding-system) - (find-coding-system cs) + (and cs (find-coding-system cs)) (if (fboundp 'coding-system-p) (when (coding-system-p cs) cs)
--- a/lisp/gnus/nnrss.el Sun Apr 10 01:47:43 2005 +0000 +++ b/lisp/gnus/nnrss.el Sun Apr 10 04:20:14 2005 +0000 @@ -1,5 +1,5 @@ ;;; nnrss.el --- interfacing with RSS -;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: RSS @@ -36,9 +36,11 @@ (require 'time-date) (require 'rfc2231) (require 'mm-url) +(require 'rfc2047) +(require 'mml) (eval-when-compile (ignore-errors - (require 'xml))) + (require 'xml))) (eval '(require 'xml)) (nnoo-declare nnrss) @@ -75,20 +77,32 @@ (defvar nnrss-content-function nil "A function which is called in `nnrss-request-article'. The arguments are (ENTRY GROUP ARTICLE). -ENTRY is the record of the current headline. GROUP is the group name. +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 + "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 -(eval-when-compile - (defmacro nnrss-string-as-multibyte (string) - (if (featurep 'xemacs) - string - `(string-as-multibyte ,string)))) +(defsubst nnrss-format-string (string) + (gnus-replace-in-string string " *\n *" " ")) + +(defun nnrss-decode-group-name (group) + (if (and group (mm-coding-system-p 'utf-8)) + (setq group (mm-decode-coding-string group 'utf-8)) + group)) (deffoo nnrss-retrieve-headers (articles &optional group server fetch-old) + (setq group (nnrss-decode-group-name group)) (nnrss-possibly-change-group group server) (let (e) (save-excursion @@ -97,21 +111,26 @@ (dolist (article articles) (if (setq e (assq article nnrss-group-data)) (insert (number-to-string (car e)) "\t" ;; number - (if (nth 3 e) - (nnrss-format-string (nth 3 e)) "") - "\t" ;; subject - (if (nth 4 e) - (nnrss-format-string (nth 4 e)) - "(nobody)") - "\t" ;;from + ;; subject + (or (nth 3 e) "") + "\t" + ;; from + (or (nth 4 e) "(nobody)") + "\t" + ;; date (or (nth 5 e) "") - "\t" ;; date + "\t" + ;; id (format "<%d@%s.nnrss>" (car e) group) - "\t" ;; id - "\t" ;; refs - "-1" "\t" ;; chars - "-1" "\t" ;; lines - "" "\t" ;; Xref + "\t" + ;; refs + "\t" + ;; chars + "-1" "\t" + ;; lines + "-1" "\t" + ;; Xref + "" "\t" (if (and (nth 6 e) (memq nnrss-description-field nnmail-extra-headers)) @@ -132,69 +151,102 @@ 'nov) (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) (deffoo nnrss-request-article (article &optional group server buffer) + (setq group (nnrss-decode-group-name group)) + (when (stringp article) + (setq article (if (string-match "\\`<\\([0-9]+\\)@" article) + (string-to-number (match-string 1 article)) + 0))) (nnrss-possibly-change-group group server) (let ((e (assq article nnrss-group-data)) - (boundary "=-=-=-=-=-=-=-=-=-") (nntp-server-buffer (or buffer nntp-server-buffer)) post err) (when e - (catch 'error - (with-current-buffer nntp-server-buffer - (erase-buffer) - (goto-char (point-min)) - (insert "Mime-Version: 1.0\nContent-Type: multipart/alternative; boundary=\"" boundary "\"\n") - (if group - (insert "Newsgroups: " group "\n")) - (if (nth 3 e) - (insert "Subject: " (nnrss-format-string (nth 3 e)) "\n")) - (if (nth 4 e) - (insert "From: " (nnrss-format-string (nth 4 e)) "\n")) - (if (nth 5 e) - (insert "Date: " (nnrss-format-string (nth 5 e)) "\n")) - (insert "Message-ID: " (format "<%d@%s.nnrss>" (car e) group) "\n") - (insert "\n") - (let ((text (if (nth 6 e) - (nnrss-string-as-multibyte (nth 6 e)))) - (link (if (nth 2 e) - (nth 2 e)))) - (insert "\n\n--" boundary "\nContent-Type: text/plain\n\n") - (let ((point (point))) - (if text - (progn (insert text) - (goto-char point) - (while (re-search-forward "\n" nil t) - (replace-match " ")) - (goto-char (point-max)) - (insert "\n\n"))) - (if link - (insert link))) - (insert "\n\n--" boundary "\nContent-Type: text/html\n\n") - (let ((point (point))) - (if text - (progn (insert "<html><head></head><body>\n" text "\n</body></html>") - (goto-char point) - (while (re-search-forward "\n" nil t) - (replace-match " ")) - (goto-char (point-max)) - (insert "\n\n"))) - (if link - (insert "<p><a href=\"" link "\">link</a></p>\n")))) - (if nnrss-content-function - (funcall nnrss-content-function e group article))))) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (if group + (insert "Newsgroups: " 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")) + (let ((header (buffer-string)) + (text (if (nth 6 e) + (mapconcat 'identity + (delete "" (split-string (nth 6 e) "\n+")) + " "))) + (link (nth 2 e)) + ;; Enable encoding of Newsgroups header in XEmacs. + (default-enable-multibyte-characters t) + (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) + (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"))) + (setq body (buffer-substring body (point))) + (insert "<#/part>\n" + "<#part type=\"text/html\">\n" + "<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" + "<#/part>\n" + "<#/multipart>\n")) + (condition-case nil + (mml-to-mime) + (error + (erase-buffer) + (insert header + "Content-Type: text/plain; charset=gnus-decoded\n" + "Content-Transfer-Encoding: 8bit\n\n" + body) + (nnheader-message + 3 "Warning - there might be invalid characters")))) + (goto-char (point-min)) + (search-forward "\n\n") + (forward-line -1) + (insert (format "Message-ID: <%d@%s.nnrss>\n" + (car e) + (let ((rfc2047-encoding-type 'mime) + rfc2047-encode-max-chars) + (rfc2047-encode-string + (gnus-replace-in-string group "[\t\n ]+" "_"))))) + (when nnrss-content-function + (funcall nnrss-content-function e group article)))) (cond (err (nnheader-report 'nnrss err)) @@ -217,6 +269,7 @@ (deffoo nnrss-request-expire-articles (articles group &optional server force) + (setq group (nnrss-decode-group-name group)) (nnrss-possibly-change-group group server) (let (e days not-expirable changed) (dolist (art articles) @@ -234,18 +287,18 @@ not-expirable)) (deffoo nnrss-request-delete-group (group &optional force server) + (setq group (nnrss-decode-group-name group)) (nnrss-possibly-change-group group server) + (let (elem) + ;; There may be two or more entries in `nnrss-group-alist' since + ;; this function didn't delete them formerly. + (while (setq elem (assoc group nnrss-group-alist)) + (setq nnrss-group-alist (delq elem nnrss-group-alist)))) (setq nnrss-server-data (delq (assoc group nnrss-server-data) nnrss-server-data)) (nnrss-save-server-data server) - (let ((file (expand-file-name - (nnrss-translate-file-chars - (concat group (and server - (not (equal server "")) - "-") - server ".el")) nnrss-directory))) - (ignore-errors - (delete-file file))) + (ignore-errors + (delete-file (nnrss-make-filename group server))) t) (deffoo nnrss-request-list-newsgroups (&optional server) @@ -262,34 +315,67 @@ ;;; Internal functions (eval-when-compile (defun xml-rpc-method-call (&rest args))) + +(defun nnrss-get-encoding () + "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)) + (if (re-search-forward + "<\\?[^>]*encoding=\\(\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)" + nil t) + (let ((encoding (intern (downcase (or (match-string 2) + (match-string 3)))))) + (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 the url and put it in a the expected lisp structure." - (with-temp-buffer - ;some CVS versions of url.el need this to close the connection quickly - (let* (xmlform htmlform) + "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 + (let (cs xmlform htmlform) ;; bit o' work necessary for w3 pre-cvs and post-cvs (if local (let ((coding-system-for-read 'binary)) (insert-file-contents url)) - (mm-url-insert url)) - -;; 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. + ;; FIXME: shouldn't binding `coding-system-for-read' be moved + ;; to `mm-url-insert'? + (let ((coding-system-for-read 'binary)) + (mm-url-insert url))) + (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)) + (goto-char (point-min)) - (condition-case err - (setq xmlform (xml-parse-region (point-min) (point-max))) - (error (if (fboundp 'w3-parse-buffer) - (setq htmlform (caddar (w3-parse-buffer - (current-buffer)))) - (message "nnrss: Not valid XML and w3 parse not available (%s)" - url)))) - (if htmlform - htmlform - xmlform)))) + ;; 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 + (setq htmlform (caddar (w3-parse-buffer + (current-buffer)))) + (error + (message "\ +nnrss: %s: Not valid XML %s and w3-parse doesn't work %s" + url err1 err2))))) + (if htmlform + htmlform + xmlform)))) (defun nnrss-possibly-change-group (&optional group server) (when (and server @@ -302,9 +388,9 @@ (defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories)) (defun nnrss-generate-active () - (if (y-or-n-p "fetch extra categories? ") - (dolist (func nnrss-extra-categories) - (funcall func))) + (when (y-or-n-p "Fetch extra categories? ") + (dolist (func nnrss-extra-categories) + (funcall func))) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) @@ -318,41 +404,26 @@ (defun nnrss-read-server-data (server) (setq nnrss-server-data nil) - (let ((file (expand-file-name - (nnrss-translate-file-chars - (concat "nnrss" (and server - (not (equal server "")) - "-") - server - ".el")) - nnrss-directory))) + (let ((file (nnrss-make-filename "nnrss" server))) (when (file-exists-p file) - (with-temp-buffer - (let ((coding-system-for-read 'binary) - emacs-lisp-mode-hook) + ;; 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) - (emacs-lisp-mode) - (goto-char (point-min)) - (eval-buffer)))))) + (eval-region (point-min) (point-max))))))) (defun nnrss-save-server-data (server) (gnus-make-directory nnrss-directory) - (let ((file (expand-file-name - (nnrss-translate-file-chars - (concat "nnrss" (and server - (not (equal server "")) - "-") - server ".el")) - nnrss-directory))) - (let ((coding-system-for-write 'binary) - print-level print-length) - (with-temp-file file - (insert "(setq nnrss-group-alist '" - (prin1-to-string nnrss-group-alist) - ")\n") - (insert "(setq nnrss-server-data '" - (prin1-to-string nnrss-server-data) - ")\n"))))) + (let ((coding-system-for-write nnrss-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) + (with-temp-file (nnrss-make-filename "nnrss" server) + (insert (format ";; -*- coding: %s; -*-\n" + nnrss-file-coding-system)) + (gnus-prin1 `(setq nnrss-group-alist ',nnrss-group-alist)) + (insert "\n") + (gnus-prin1 `(setq nnrss-server-data ',nnrss-server-data))))) (defun nnrss-read-group-data (group server) (setq nnrss-group-data nil) @@ -360,43 +431,50 @@ (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 (expand-file-name - (nnrss-translate-file-chars - (concat group (and server - (not (equal server "")) - "-") - server ".el")) - nnrss-directory))) + (let ((file (nnrss-make-filename group server))) (when (file-exists-p file) - (with-temp-buffer - (let ((coding-system-for-read 'binary) - emacs-lisp-mode-hook) + ;; 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) - (emacs-lisp-mode) - (goto-char (point-min)) - (eval-buffer))) + (eval-region (point-min) (point-max)))) (dolist (e nnrss-group-data) - (gnus-sethash (nth 2 e) e nnrss-group-hashtb) - (if (and (car e) (> nnrss-group-min (car e))) - (setq nnrss-group-min (car e))) - (if (and (car e) (< nnrss-group-max (car e))) - (setq nnrss-group-max (car e))))))) + (gnus-sethash (or (nth 2 e) (nth 6 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))) + (setq nnrss-group-max (car e))))))) (defun nnrss-save-group-data (group server) (gnus-make-directory nnrss-directory) - (let ((file (expand-file-name - (nnrss-translate-file-chars - (concat group (and server - (not (equal server "")) - "-") - server ".el")) - nnrss-directory))) - (let ((coding-system-for-write 'binary) - print-level print-length) - (with-temp-file file - (insert "(setq nnrss-group-data '" - (prin1-to-string nnrss-group-data) - ")\n"))))) + (let ((coding-system-for-write nnrss-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) + (with-temp-file (nnrss-make-filename group server) + (insert (format ";; -*- coding: %s; -*-\n" + nnrss-file-coding-system)) + (gnus-prin1 `(setq nnrss-group-data ',nnrss-group-data))))) + +(defun nnrss-make-filename (name server) + (expand-file-name + (nnrss-translate-file-chars + (concat name + (and server + (not (equal server "")) + "-") + server + ".el")) + nnrss-directory)) + +(gnus-add-shutdown 'nnrss-close 'gnus) + +(defun nnrss-close () + "Clear internal nnrss variables." + (setq nnrss-group-data nil + nnrss-server-data nil + nnrss-group-hashtb nil + nnrss-group-alist nil)) ;;; URL interface @@ -407,15 +485,36 @@ (mm-with-unibyte-current-buffer (mm-url-insert url))) -(defun nnrss-decode-entities-unibyte-string (string) +(defun nnrss-decode-entities-string (string) (if string - (mm-with-unibyte-buffer + (mm-with-multibyte-buffer (insert 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) + (mm-url-decode-entities-nbsp) + (goto-char (point-min)) + (while (re-search-forward "[\t\n ]+" nil t) + (replace-match " ")) + (goto-char (point-min)) + (skip-chars-forward " ") + (delete-region (point-min) (point)) + (goto-char (point-max)) + (skip-chars-forward " ") + (delete-region (point) (point-max)) + (let ((rfc2047-encoding-type 'mime) + rfc2047-encode-max-chars) + (rfc2047-encode-region (point-min) (point-max))) + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (delete-backward-char 1)) + (buffer-string))) + ;;; Snarf functions (defun nnrss-check-group (group server) @@ -431,11 +530,11 @@ (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)) @@ -451,12 +550,16 @@ content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/")) (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml))) (when (and (listp item) - (eq (intern (concat rss-ns "item")) (car item)) - (setq url (nnrss-decode-entities-unibyte-string - (nnrss-node-text rss-ns 'link (cddr item)))) - (not (gnus-gethash url nnrss-group-hashtb))) + (string= (concat rss-ns "item") (car item)) + (if (setq url (nnrss-decode-entities-string + (nnrss-node-text rss-ns 'link (cddr item)))) + (not (gnus-gethash url nnrss-group-hashtb)) + (setq extra (or (nnrss-node-text content-ns 'encoded item) + (nnrss-node-text rss-ns 'description item))) + (not (gnus-gethash extra nnrss-group-hashtb)))) (setq subject (nnrss-node-text rss-ns 'title item)) - (setq extra (or (nnrss-node-text content-ns 'encoded item) + (setq extra (or extra + (nnrss-node-text content-ns 'encoded item) (nnrss-node-text rss-ns 'description item))) (setq author (or (nnrss-node-text rss-ns 'author item) (nnrss-node-text dc-ns 'creator item) @@ -469,13 +572,14 @@ (incf nnrss-group-max) (current-time) url - (and subject (nnrss-decode-entities-unibyte-string subject)) - (and author (nnrss-decode-entities-unibyte-string author)) + (and subject (nnrss-mime-encode-string subject)) + (and author (nnrss-mime-encode-string author)) date - (and extra (nnrss-decode-entities-unibyte-string extra))) + (and extra (nnrss-decode-entities-string extra))) nnrss-group-data) - (gnus-sethash url (car nnrss-group-data) nnrss-group-hashtb) - (setq changed t))) + (gnus-sethash (or url extra) t nnrss-group-hashtb) + (setq changed t)) + (setq extra nil)) (when changed (nnrss-save-group-data group server) (let ((pair (assoc group nnrss-server-data))) @@ -484,6 +588,45 @@ (push (list group nnrss-group-max) nnrss-server-data))) (nnrss-save-server-data server)))) +(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))))) + (nnrss-find-el 'outline + (progn + (find-file opml-file) + (xml-parse-region (point-min) + (point-max)))))) + +(defun nnrss-opml-export () + "OPML subscription export. +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 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" + "<!-- OPML generated by Emacs Gnus' nnrss.el -->\n" + "<opml version=\"1.1\">\n" + " <head>\n" + " <title>mySubscriptions</title>\n" + " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z") + "</dateCreated>\n" + " <ownerEmail>" user-mail-address "</ownerEmail>\n" + " <ownerName>" (user-full-name) "</ownerName>\n" + " </head>\n" + " <body>\n") + (dolist (sub nnrss-group-alist) + (insert " <outline text=\"" (car sub) + "\" xmlUrl=\"" (cadr sub) "\"/>\n")) + (insert " </body>\n" + "</opml>\n")) + (pop-to-buffer "*OPML Export*") + (when (fboundp 'sgml-mode) + (sgml-mode))) + (defun nnrss-generate-download-script () "Generate a download script in the current buffer. It is useful when `(setq nnrss-use-local t)'." @@ -530,9 +673,6 @@ (if changed (nnrss-save-server-data "")))) -(defun nnrss-format-string (string) - (gnus-replace-in-string (nnrss-string-as-multibyte string) " *\n *" " ")) - (defun nnrss-node-text (namespace local-name element) (let* ((node (assq (intern (concat namespace (symbol-name local-name))) element)) @@ -551,56 +691,59 @@ node)) (defun nnrss-find-el (tag data &optional found-list) - "Find the all matching elements in the data. Careful with this on -large documents!" - (if (listp data) - (mapcar (lambda (bit) - (if (car-safe bit) - (progn (if (equal tag (car bit)) - (setq found-list - (append found-list - (list bit)))) - (if (and (listp (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)) + "Find the all matching elements in the data. +Careful with this on large documents!" + (when (consp 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) "Test if the element we are handed is an RSS autodiscovery link." (and (eq (car-safe el) 'link) (string-equal (cdr (assoc 'rel (cadr el))) "alternate") - (or (string-equal (cdr (assoc 'type (cadr el))) + (or (string-equal (cdr (assoc 'type (cadr el))) "application/rss+xml") (string-equal (cdr (assoc 'type (cadr el))) "text/xml")))) (defun nnrss-get-rsslinks (data) "Extract the <link> elements that are links to RSS from the parsed data." - (delq nil (mapcar + (delq nil (mapcar (lambda (el) (if (nnrss-rsslink-p el) el)) (nnrss-find-el 'link data)))) (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." + "Recursively extract hrefs from a page's source. +DATA should be the output of `xml-parse-region' or +`w3-parse-buffer'." (mapcar (lambda (ahref) (cdr (assoc 'href (cadr ahref)))) (nnrss-find-el 'a data))) -(defmacro nnrss-match-macro (base-uri item - onsite-list offsite-list) +(defmacro nnrss-match-macro (base-uri item onsite-list offsite-list) `(cond ((or (string-match (concat "^" ,base-uri) ,item) - (not (string-match "://" ,item))) - (setq ,onsite-list (append ,onsite-list (list ,item)))) - (t (setq ,offsite-list (append ,offsite-list (list ,item)))))) + (not (string-match "://" ,item))) + (setq ,onsite-list (append ,onsite-list (list ,item)))) + (t (setq ,offsite-list (append ,offsite-list (list ,item)))))) (defun nnrss-order-hrefs (base-uri hrefs) "Given a list of hrefs, sort them using the following priorities: @@ -615,29 +758,28 @@ (let (rss-onsite-end rdf-onsite-end xml-onsite-end 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) - (mapcar (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) - (append + rss-offsite-in rdf-offsite-in xml-offsite-in) + (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 rss-offsite-end rdf-offsite-end xml-offsite-end @@ -670,23 +812,23 @@ ;; - offsite links containing any of the above (let* ((base-uri (progn (string-match ".*://[^/]+/?" url) (match-string 0 url))) - (hrefs (nnrss-order-hrefs + (hrefs (nnrss-order-hrefs base-uri (nnrss-extract-hrefs parsed-page))) (rss-link nil)) - (while (and (eq rss-link nil) (not (eq hrefs nil))) - (let ((href-data (nnrss-fetch (car hrefs)))) - (if (nnrss-rss-p href-data) - (let* ((rss-ns (nnrss-get-namespace-prefix href-data "http://purl.org/rss/1.0/"))) - (setq rss-link (nnrss-rss-title-description - rss-ns href-data (car hrefs)))) - (setq hrefs (cdr hrefs))))) - (if rss-link rss-link + (while (and (eq rss-link nil) (not (eq hrefs nil))) + (let ((href-data (nnrss-fetch (car hrefs)))) + (if (nnrss-rss-p href-data) + (let* ((rss-ns (nnrss-get-namespace-prefix href-data "http://purl.org/rss/1.0/"))) + (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 - (nnrss-find-rss-via-syndic8 url)))))))) + (nnrss-find-rss-via-syndic8 url)))))))) (defun nnrss-find-rss-via-syndic8 (url) - "query syndic8 for the rss feeds it has for the url." + "Query syndic8 for the rss feeds it has for URL." (if (not (locate-library "xml-rpc")) (progn (message "XML-RPC is not available... not checking Syndic8.") @@ -697,22 +839,22 @@ 'syndic8.FindSites url))) (when feedid - (let* ((feedinfo (xml-rpc-method-call + (let* ((feedinfo (xml-rpc-method-call "http://www.syndic8.com/xmlrpc.php" 'syndic8.GetFeedInfo feedid)) (urllist - (delq nil + (delq nil (mapcar (lambda (listinfo) - (if (string-equal + (if (string-equal (cdr (assoc "status" listinfo)) "Syndicated") (cons (cdr (assoc "sitename" listinfo)) (list (cons 'title - (cdr (assoc + (cdr (assoc "sitename" listinfo))) (cons 'href (cdr (assoc @@ -721,20 +863,20 @@ (if (not (> (length urllist) 1)) (cdar urllist) (let ((completion-ignore-case t) - (selection + (selection (mapcar (lambda (listinfo) - (cons (cdr (assoc "sitename" listinfo)) - (string-to-int + (cons (cdr (assoc "sitename" listinfo)) + (string-to-int (cdr (assoc "feedid" listinfo))))) feedinfo))) - (cdr (assoc + (cdr (assoc (completing-read "Multiple feeds found. Select one: " selection nil t) urllist))))))))) (defun nnrss-rss-p (data) - "Test if data is an RSS feed. Simply ensures that the first -element is rss or rdf." + "Test if DATA is an RSS feed. +Simply ensures that the first element is rss or rdf." (or (eq (caar data) 'rss) (eq (caar data) 'rdf:RDF))) @@ -755,13 +897,13 @@ that gives the URI for which you want to retrieve the namespace prefix), return the prefix." (let* ((prefix (car (rassoc uri (cadar el)))) - (nslist (if prefix + (nslist (if prefix (split-string (symbol-name prefix) ":"))) (ns (cond ((eq (length nslist) 1) ; no prefix given "") ((eq (length nslist) 2) ; extract prefix (cadr nslist))))) - (if (and ns (not (eq ns ""))) + (if (and ns (not (string= ns ""))) (concat ns ":") ns)))
--- a/man/ChangeLog Sun Apr 10 01:47:43 2005 +0000 +++ b/man/ChangeLog Sun Apr 10 04:20:14 2005 +0000 @@ -1,3 +1,7 @@ +2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (RSS): Addition. + 2005-04-09 Luc Teirlinck <teirllm@auburn.edu> * display.texi (Useless Whitespace): `indicate-unused-lines' is
--- a/man/gnus.texi Sun Apr 10 01:47:43 2005 +0000 +++ b/man/gnus.texi Sun Apr 10 04:20:14 2005 +0000 @@ -15873,14 +15873,45 @@ @acronym{RSS} has a quite regular and nice interface, and it's possible to get the information Gnus needs to keep groups updated. +Note: you had better use Emacs which supports the @code{utf-8} coding +system because @acronym{RSS} uses UTF-8 for encoding non-@acronym{ASCII} +text by default. It is also used by default for non-@acronym{ASCII} +group names. + @kindex G R (Summary) -Use @kbd{G R} from the summary buffer to subscribe to a feed---you -will be prompted for the location of the feed. +Use @kbd{G R} from the summary buffer to subscribe to a feed---you will +be prompted for the location, the title and the description of the feed. +The title, which allows any characters, will be used for the group name +and the name of the group data file. The description can be omitted. An easy way to get started with @code{nnrss} is to say something like the following in the group buffer: @kbd{B nnrss RET RET y}, then subscribe to groups. +The @code{nnrss} back end saves the group data file in +@code{nnrss-directory} (see below) for each @code{nnrss} group. File +names containing non-@acronym{ASCII} characters will be encoded by the +coding system specified with the @code{nnmail-pathname-coding-system} +variable. If it is @code{nil}, in Emacs the coding system defaults to +the value of @code{default-file-name-coding-system}. If you are using +XEmacs and want to use non-@acronym{ASCII} group names, you should set +the value for the @code{nnmail-pathname-coding-system} variable properly. + +@cindex OPML +You can also use the following commands to import and export your +subscriptions from a file in @acronym{OPML} format (Outline Processor +Markup Language). + +@defun nnrss-opml-import file +Prompt for an @acronym{OPML} file, and subscribe to each feed in the +file. +@end defun + +@defun nnrss-opml-export +Write your current @acronym{RSS} subscriptions to a buffer in +@acronym{OPML} format. +@end defun + The following @code{nnrss} variables can be altered: @table @code @@ -15889,6 +15920,13 @@ The directory where @code{nnrss} stores its files. The default is @file{~/News/rss/}. +@item nnrss-file-coding-system +@vindex nnrss-file-coding-system +The coding system used when reading and writing the @code{nnrss} groups +data files. The default is the value of +@code{mm-universal-coding-system} (which defaults to @code{emacs-mule} +in Emacs or @code{escape-quoted} in XEmacs). + @item nnrss-use-local @vindex nnrss-use-local @findex nnrss-generate-download-script