aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiles Bader2005-04-10 04:20:14 +0000
committerMiles Bader2005-04-10 04:20:14 +0000
commit914725789124cc98bd45480abc2eca10a383454c (patch)
tree06c9978205156dee41bb14e6efcc0ce91e337be9
parent36178ae8fb086e8ece1ca9408dfa18a2fe9e82ba (diff)
downloademacs-914725789124cc98bd45480abc2eca10a383454c.tar.gz
emacs-914725789124cc98bd45480abc2eca10a383454c.zip
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.
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/calendar/time-date.el21
-rw-r--r--lisp/gnus/ChangeLog128
-rw-r--r--lisp/gnus/gnus-agent.el10
-rw-r--r--lisp/gnus/gnus-cache.el5
-rw-r--r--lisp/gnus/gnus-group.el82
-rw-r--r--lisp/gnus/gnus-spec.el9
-rw-r--r--lisp/gnus/gnus-sum.el5
-rw-r--r--lisp/gnus/mm-url.el2
-rw-r--r--lisp/gnus/mm-util.el10
-rw-r--r--lisp/gnus/nnrss.el668
-rw-r--r--man/ChangeLog4
-rw-r--r--man/gnus.texi42
13 files changed, 672 insertions, 320 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 724de4fb757..078fe15fc81 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
12005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * calendar/time-date.el (time-to-seconds): Don't use the #xhhhh
4 syntax which Emacs 20 doesn't support.
5 (seconds-to-time, days-to-time, time-subtract, time-add): Ditto.
6
12005-04-09 Stefan Monnier <monnier@iro.umontreal.ca> 72005-04-09 Stefan Monnier <monnier@iro.umontreal.ca>
2 8
3 * arc-mode.el (archive-mode-map): Move initialization into 9 * arc-mode.el (archive-mode-map): Move initialization into
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 7160d26ef42..ddeb33b411a 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -1,5 +1,6 @@
1;;; time-date.el --- Date and time handling functions 1;;; time-date.el --- Date and time handling functions
2;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2004, 2005 Free Software Foundation, Inc. 2;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2004, 2005
3;; Free Software Foundation, Inc.
3 4
4;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5;; Masanobu Umeda <umerin@mse.kyutech.ac.jp> 6;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
@@ -112,15 +113,15 @@ and type 3 is the list (HIGH LOW MICRO)."
112 "Convert time value TIME to a floating point number. 113 "Convert time value TIME to a floating point number.
113You can use `float-time' instead." 114You can use `float-time' instead."
114 (with-decoded-time-value ((high low micro time)) 115 (with-decoded-time-value ((high low micro time))
115 (+ (* 1.0 high #x10000) 116 (+ (* 1.0 high 65536)
116 low 117 low
117 (/ micro 1000000.0)))) 118 (/ micro 1000000.0))))
118 119
119;;;###autoload 120;;;###autoload
120(defun seconds-to-time (seconds) 121(defun seconds-to-time (seconds)
121 "Convert SECONDS (a floating point number) to a time value." 122 "Convert SECONDS (a floating point number) to a time value."
122 (list (floor seconds #x10000) 123 (list (floor seconds 65536)
123 (floor (mod seconds #x10000)) 124 (floor (mod seconds 65536))
124 (floor (* (- seconds (ffloor seconds)) 1000000)))) 125 (floor (* (- seconds (ffloor seconds)) 1000000))))
125 126
126;;;###autoload 127;;;###autoload
@@ -138,10 +139,10 @@ You can use `float-time' instead."
138(defun days-to-time (days) 139(defun days-to-time (days)
139 "Convert DAYS into a time value." 140 "Convert DAYS into a time value."
140 (let* ((seconds (* 1.0 days 60 60 24)) 141 (let* ((seconds (* 1.0 days 60 60 24))
141 (high (condition-case nil (floor (/ seconds #x10000)) 142 (high (condition-case nil (floor (/ seconds 65536))
142 (range-error most-positive-fixnum)))) 143 (range-error most-positive-fixnum))))
143 (list high (condition-case nil (floor (- seconds (* 1.0 high #x10000))) 144 (list high (condition-case nil (floor (- seconds (* 1.0 high 65536)))
144 (range-error #xffff))))) 145 (range-error 65535)))))
145 146
146;;;###autoload 147;;;###autoload
147(defun time-since (time) 148(defun time-since (time)
@@ -170,7 +171,7 @@ Return the difference in the format of a time value."
170 micro (+ micro 1000000))) 171 micro (+ micro 1000000)))
171 (when (< low 0) 172 (when (< low 0)
172 (setq high (1- high) 173 (setq high (1- high)
173 low (+ low #x10000))) 174 low (+ low 65536)))
174 (encode-time-value high low micro type))) 175 (encode-time-value high low micro type)))
175 176
176;;;###autoload 177;;;###autoload
@@ -185,9 +186,9 @@ Return the difference in the format of a time value."
185 (when (>= micro 1000000) 186 (when (>= micro 1000000)
186 (setq low (1+ low) 187 (setq low (1+ low)
187 micro (- micro 1000000))) 188 micro (- micro 1000000)))
188 (when (>= low #x10000) 189 (when (>= low 65536)
189 (setq high (1+ high) 190 (setq high (1+ high)
190 low (- low #x10000))) 191 low (- low 65536)))
191 (encode-time-value high low micro type))) 192 (encode-time-value high low micro type)))
192 193
193;;;###autoload 194;;;###autoload
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index d8e1065c610..7eb877a669f 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,131 @@
12005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * mm-util.el (mm-coding-system-p): Don't return binary for the nil
4 argument in XEmacs.
5
6 * nnrss.el (nnrss-compatible-encoding-alist): New variable.
7 (nnrss-request-group): Decode group name first.
8 (nnrss-request-article): Make a text/plain article if mml-to-mime
9 failed.
10 (nnrss-get-encoding): Return a compatible encoding according to
11 nnrss-compatible-encoding-alist.
12 (nnrss-opml-export): Use dolist.
13 (nnrss-find-el): Use consp instead of listp.
14 (nnrss-order-hrefs): Use dolist.
15
162005-04-06 Arne J,Ax(Brgensen <arne@arnested.dk>
17
18 * nnrss.el (nnrss-verbose): Remove.
19 (nnrss-request-group): Use `nnheader-message' instead.
20
212005-04-06 Mark Plaksin <happy@usg.edu> (tiny change)
22
23 * nnrss.el (nnrss-verbose): New variable.
24 (nnrss-request-group): Make it say nnrss is requesting a group.
25
262005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
27
28 * gnus-agent.el (gnus-agent-group-path): Decode group name.
29 (gnus-agent-group-pathname): Ditto.
30
31 * gnus-cache.el (gnus-cache-file-name): Decode group name.
32
33 * gnus-group.el (gnus-group-line-format-alist): Use decoded group
34 name for only %g and %c.
35 (gnus-group-insert-group-line): Bind gnus-tmp-decoded-group
36 instead of gnus-tmp-group to decoded group name.
37 (gnus-group-make-group): Decode group name.
38 (gnus-group-delete-group): Ditto.
39 (gnus-group-make-rss-group): Exclude `/'s from group names;
40 register the group data after opening the nnrss group; unify
41 non-ASCII group names; encode group name.
42 (gnus-group-catchup-current): Decode group name.
43 (gnus-group-expire-articles-1): Ditto.
44 (gnus-group-set-current-level): Ditto.
45 (gnus-group-kill-group): Ditto.
46
47 * gnus-spec.el (gnus-update-format-specifications): Flush the
48 group format spec cache if it doesn't support decoded group names.
49
50 * mm-url.el (mm-url-predefined-programs): Add --silent arg to curl.
51
52 * nnrss.el: Require rfc2047 and mml.
53 (nnrss-file-coding-system): New variable.
54 (nnrss-format-string): Redefine it as an inline function.
55 (nnrss-decode-group-name): New function.
56 (nnrss-string-as-multibyte): Remove.
57 (nnrss-retrieve-headers): Decode group name; don't use
58 nnrss-format-string.
59 (nnrss-request-group): Decode group name.
60 (nnrss-request-article): Decode group name; allow a Message-ID as
61 well as an article number; don't use nnrss-format-string; encode a
62 Message-ID string which may contain non-ASCII characters; use
63 mml-to-mime to compose a MIME article; use search-forward instead
64 of re-search-forward.
65 (nnrss-request-expire-articles): Decode group name.
66 (nnrss-request-delete-group): Delete entries in nnrss-group-alist
67 as well; decode group name.
68 (nnrss-get-encoding): Fix regexp.
69 (nnrss-fetch): Clarify error message.
70 (nnrss-read-server-data): Use insert-file-contents instead of load;
71 bind file-name-coding-system; use multibyte buffer.
72 (nnrss-save-server-data): Insert newline; bind
73 coding-system-for-write to the value of nnrss-file-coding-system;
74 bind file-name-coding-system; add coding cookie.
75 (nnrss-read-group-data): Use insert-file-contents instead of load;
76 bind file-name-coding-system; use multibyte buffer.
77 (nnrss-save-group-data): Bind coding-system-for-write to the
78 value of nnrss-file-coding-system; bind file-name-coding-system.
79 (nnrss-decode-entities-string): Rename from n-d-e-unibyte-string;
80 make it work with non-ASCII text.
81 (nnrss-opml-export): Use mm-set-buffer-file-coding-system instead
82 of set-buffer-file-coding-system.
83 (nnrss-find-el): Check carefully whether there's a list of string
84 which old xml.el may return rather than a string; make it work
85 with old xml.el as well.
86
872005-04-06 Tsuyoshi AKIHO <akiho@kawachi.zaq.ne.jp>
88
89 * gnus-sum.el (gnus-summary-walk-group-buffer): Decode group name.
90
91 * nnrss.el (nnrss-get-encoding): New function.
92 (nnrss-fetch): Use unibyte buffer initially; bind
93 coding-system-for-read while performing mm-url-insert; remove ^Ms;
94 decode contents according to the encoding attribute.
95 (nnrss-save-group-data): Add coding cookie.
96 (nnrss-mime-encode-string): New function.
97 (nnrss-check-group): Use it to encode subject and author.
98
992005-04-06 Maciek Pasternacki <maciekp@japhy.fnord.org> (tiny change)
100
101 * nnrss.el (nnrss-fetch): Signal an error if w3-parse-buffer also
102 failed.
103
1042005-04-06 Jesper Harder <harder@ifa.au.dk>
105
106 * mm-util.el (mm-subst-char-in-string): Support inplace.
107
108 * nnrss.el: Pedantic docstring and whitespace fixes (courtesy of
109 checkdoc.el).
110 (nnrss-request-article): Cleanup.
111 (nnrss-request-delete-group): Use nnrss-make-filename.
112 (nnrss-read-server-data): Use nnrss-make-filename; use load.
113 (nnrss-save-server-data): Use nnrss-make-filename; use gnus-prin1.
114 (nnrss-read-group-data): Fix off-by-one error. From Joakim Verona
115 <joakim@verona.se>; hash on description if link is missing; use
116 nnrss-make-filename; use load.
117 (nnrss-save-group-data): Use nnrss-make-filename; use gnus-prin1.
118 (nnrss-make-filename): New function.
119 (nnrss-close): New function.
120 (nnrss-check-group): Hash on description if link is missing.
121 (nnrss-get-namespace-prefix): Use string= to compare strings!
122 Reported by David D. Smith <davidsmith@acm.org>.
123 (nnrss-opml-export): Turn on sgml-mode.
124
1252005-04-06 Mark A. Hershberger <mah@everybody.org>
126
127 * nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions.
128
12005-04-04 Reiner Steib <Reiner.Steib@gmx.de> 1292005-04-04 Reiner Steib <Reiner.Steib@gmx.de>
2 130
3 * message.el (message-make-date): Add defvars in order to silence 131 * message.el (message-make-date): Add defvars in order to silence
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 9a02f5b38aa..4236c7958fb 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1,5 +1,5 @@
1;;; gnus-agent.el --- unplugged support for Gnus 1;;; gnus-agent.el --- unplugged support for Gnus
2;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 2;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
3;; Free Software Foundation, Inc. 3;; Free Software Foundation, Inc.
4 4
5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -1371,7 +1371,7 @@ downloaded into the agent."
1371 (nnheader-translate-file-chars 1371 (nnheader-translate-file-chars
1372 (nnheader-replace-duplicate-chars-in-string 1372 (nnheader-replace-duplicate-chars-in-string
1373 (nnheader-replace-chars-in-string 1373 (nnheader-replace-chars-in-string
1374 (gnus-group-real-name group) 1374 (gnus-group-real-name (gnus-group-decoded-name group))
1375 ?/ ?_) 1375 ?/ ?_)
1376 ?. ?_))) 1376 ?. ?_)))
1377 (if (or nnmail-use-long-file-names 1377 (if (or nnmail-use-long-file-names
@@ -1387,8 +1387,10 @@ downloaded into the agent."
1387 ;; unplugged. The agent must, therefore, use the same directory 1387 ;; unplugged. The agent must, therefore, use the same directory
1388 ;; while plugged. 1388 ;; while plugged.
1389 (let ((gnus-command-method (or gnus-command-method 1389 (let ((gnus-command-method (or gnus-command-method
1390 (gnus-find-method-for-group group)))) 1390 (gnus-find-method-for-group group))))
1391 (nnmail-group-pathname (gnus-group-real-name group) (gnus-agent-directory)))) 1391 (nnmail-group-pathname (gnus-group-real-name
1392 (gnus-group-decoded-name group))
1393 (gnus-agent-directory))))
1392 1394
1393(defun gnus-agent-get-function (method) 1395(defun gnus-agent-get-function (method)
1394 (if (gnus-online method) 1396 (if (gnus-online method)
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 8f2b491f5a4..657ade98167 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -1,6 +1,6 @@
1;;; gnus-cache.el --- cache interface for Gnus 1;;; gnus-cache.el --- cache interface for Gnus
2;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 2;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
3;; Free Software Foundation, Inc. 3;; 2004, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6;; Keywords: news 6;; Keywords: news
@@ -421,6 +421,7 @@ Returns the list of articles removed."
421 (and (not unread) (not ticked) (not dormant) (memq 'read class)))) 421 (and (not unread) (not ticked) (not dormant) (memq 'read class))))
422 422
423(defun gnus-cache-file-name (group article) 423(defun gnus-cache-file-name (group article)
424 (setq group (gnus-group-decoded-name group))
424 (expand-file-name 425 (expand-file-name
425 (if (stringp article) article (int-to-string article)) 426 (if (stringp article) article (int-to-string article))
426 (file-name-as-directory 427 (file-name-as-directory
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 6d38626998c..30b7fe68dd1 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -482,9 +482,15 @@ simple manner.")
482 (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) 482 (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
483 (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) 483 (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
484 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) 484 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
485 (?g gnus-tmp-group ?s) 485 (?g (if (boundp 'gnus-tmp-decoded-group)
486 gnus-tmp-decoded-group
487 gnus-tmp-group)
488 ?s)
486 (?G gnus-tmp-qualified-group ?s) 489 (?G gnus-tmp-qualified-group ?s)
487 (?c (gnus-short-group-name gnus-tmp-group) ?s) 490 (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
491 gnus-tmp-decoded-group
492 gnus-tmp-group))
493 ?s)
488 (?C gnus-tmp-comment ?s) 494 (?C gnus-tmp-comment ?s)
489 (?D gnus-tmp-newsgroup-description ?s) 495 (?D gnus-tmp-newsgroup-description ?s)
490 (?o gnus-tmp-moderated ?c) 496 (?o gnus-tmp-moderated ?c)
@@ -1441,8 +1447,8 @@ if it is a string, only list groups matching REGEXP."
1441 (point) 1447 (point)
1442 (prog1 (1+ (point)) 1448 (prog1 (1+ (point))
1443 ;; Insert the text. 1449 ;; Insert the text.
1444 (let ((gnus-tmp-group (gnus-group-name-decode 1450 (let ((gnus-tmp-decoded-group (gnus-group-name-decode
1445 gnus-tmp-group group-name-charset))) 1451 gnus-tmp-group group-name-charset)))
1446 (eval gnus-group-line-format-spec))) 1452 (eval gnus-group-line-format-spec)))
1447 `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) 1453 `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
1448 gnus-unread ,(if (numberp number) 1454 gnus-unread ,(if (numberp number)
@@ -2244,7 +2250,7 @@ ADDRESS."
2244 (nname (if method (gnus-group-prefixed-name name meth) name)) 2250 (nname (if method (gnus-group-prefixed-name name meth) name))
2245 backend info) 2251 backend info)
2246 (when (gnus-gethash nname gnus-newsrc-hashtb) 2252 (when (gnus-gethash nname gnus-newsrc-hashtb)
2247 (error "Group %s already exists" nname)) 2253 (error "Group %s already exists" (gnus-group-decoded-name nname)))
2248 ;; Subscribe to the new group. 2254 ;; Subscribe to the new group.
2249 (gnus-group-change-level 2255 (gnus-group-change-level
2250 (setq info (list t nname gnus-level-default-subscribed nil nil meth)) 2256 (setq info (list t nname gnus-level-default-subscribed nil nil meth))
@@ -2305,20 +2311,21 @@ be removed from the server, even when it's empty."
2305 (unless (gnus-check-backend-function 'request-delete-group group) 2311 (unless (gnus-check-backend-function 'request-delete-group group)
2306 (error "This back end does not support group deletion")) 2312 (error "This back end does not support group deletion"))
2307 (prog1 2313 (prog1
2308 (if (and (not no-prompt) 2314 (let ((group-decoded (gnus-group-decoded-name group)))
2309 (not (gnus-yes-or-no-p 2315 (if (and (not no-prompt)
2310 (format 2316 (not (gnus-yes-or-no-p
2311 "Do you really want to delete %s%s? " 2317 (format
2312 group (if force " and all its contents" ""))))) 2318 "Do you really want to delete %s%s? "
2313 () ; Whew! 2319 group-decoded (if force " and all its contents" "")))))
2314 (gnus-message 6 "Deleting group %s..." group) 2320 () ; Whew!
2315 (if (not (gnus-request-delete-group group force)) 2321 (gnus-message 6 "Deleting group %s..." group-decoded)
2316 (gnus-error 3 "Couldn't delete group %s" group) 2322 (if (not (gnus-request-delete-group group force))
2317 (gnus-message 6 "Deleting group %s...done" group) 2323 (gnus-error 3 "Couldn't delete group %s" group-decoded)
2318 (gnus-group-goto-group group) 2324 (gnus-message 6 "Deleting group %s...done" group-decoded)
2319 (gnus-group-kill-group 1 t) 2325 (gnus-group-goto-group group)
2320 (gnus-sethash group nil gnus-active-hashtb) 2326 (gnus-group-kill-group 1 t)
2321 t)) 2327 (gnus-sethash group nil gnus-active-hashtb)
2328 t)))
2322 (gnus-group-position-point))) 2329 (gnus-group-position-point)))
2323 2330
2324(defun gnus-group-rename-group (group new-name) 2331(defun gnus-group-rename-group (group new-name)
@@ -2588,16 +2595,26 @@ If there is, use Gnus to create an nnrss group"
2588 (setq url (read-from-minibuffer "URL to Search for RSS: "))) 2595 (setq url (read-from-minibuffer "URL to Search for RSS: ")))
2589 (let ((feedinfo (nnrss-discover-feed url))) 2596 (let ((feedinfo (nnrss-discover-feed url)))
2590 (if feedinfo 2597 (if feedinfo
2591 (let ((title (read-from-minibuffer "Title: " 2598 (let ((title (gnus-newsgroup-savable-name
2592 (cdr (assoc 'title 2599 (read-from-minibuffer "Title: "
2593 feedinfo)))) 2600 (gnus-newsgroup-savable-name
2601 (or (cdr (assoc 'title
2602 feedinfo))
2603 "")))))
2594 (desc (read-from-minibuffer "Description: " 2604 (desc (read-from-minibuffer "Description: "
2595 (cdr (assoc 'description 2605 (cdr (assoc 'description
2596 feedinfo)))) 2606 feedinfo))))
2597 (href (cdr (assoc 'href feedinfo)))) 2607 (href (cdr (assoc 'href feedinfo)))
2598 (push (list title href desc) 2608 (encodable (mm-coding-system-p 'utf-8)))
2599 nnrss-group-alist) 2609 (when encodable
2600 (gnus-group-make-group title '(nnrss "")) 2610 ;; Unify non-ASCII text.
2611 (setq title (mm-decode-coding-string
2612 (mm-encode-coding-string title 'utf-8) 'utf-8)))
2613 (gnus-group-make-group (if encodable
2614 (mm-encode-coding-string title 'utf-8)
2615 title)
2616 '(nnrss ""))
2617 (push (list title href desc) nnrss-group-alist)
2601 (nnrss-save-server-data nil)) 2618 (nnrss-save-server-data nil))
2602 (error "No feeds found for %s" url)))) 2619 (error "No feeds found for %s" url))))
2603 2620
@@ -3101,7 +3118,7 @@ up is returned."
3101 "Do you really want to mark all articles in %s as read? " 3118 "Do you really want to mark all articles in %s as read? "
3102 "Mark all unread articles in %s as read? ") 3119 "Mark all unread articles in %s as read? ")
3103 (if (= (length groups) 1) 3120 (if (= (length groups) 1)
3104 (car groups) 3121 (gnus-group-decoded-name (car groups))
3105 (format "these %d groups" (length groups))))))) 3122 (format "these %d groups" (length groups)))))))
3106 n 3123 n
3107 (while (setq group (pop groups)) 3124 (while (setq group (pop groups))
@@ -3179,7 +3196,8 @@ Uses the process/prefix convention."
3179 3196
3180(defun gnus-group-expire-articles-1 (group) 3197(defun gnus-group-expire-articles-1 (group)
3181 (when (gnus-check-backend-function 'request-expire-articles group) 3198 (when (gnus-check-backend-function 'request-expire-articles group)
3182 (gnus-message 6 "Expiring articles in %s..." group) 3199 (gnus-message 6 "Expiring articles in %s..."
3200 (gnus-group-decoded-name group))
3183 (let* ((info (gnus-get-info group)) 3201 (let* ((info (gnus-get-info group))
3184 (expirable (if (gnus-group-total-expirable-p group) 3202 (expirable (if (gnus-group-total-expirable-p group)
3185 (cons nil (gnus-list-of-read-articles group)) 3203 (cons nil (gnus-list-of-read-articles group))
@@ -3204,7 +3222,8 @@ Uses the process/prefix convention."
3204 (gnus-request-expire-articles 3222 (gnus-request-expire-articles
3205 (gnus-uncompress-sequence (cdr expirable)) group)))) 3223 (gnus-uncompress-sequence (cdr expirable)) group))))
3206 (gnus-close-group group)) 3224 (gnus-close-group group))
3207 (gnus-message 6 "Expiring articles in %s...done" group) 3225 (gnus-message 6 "Expiring articles in %s...done"
3226 (gnus-group-decoded-name group))
3208 ;; Return the list of un-expired articles. 3227 ;; Return the list of un-expired articles.
3209 (cdr expirable)))) 3228 (cdr expirable))))
3210 3229
@@ -3243,7 +3262,8 @@ Uses the process/prefix convention."
3243 (while (setq group (pop groups)) 3262 (while (setq group (pop groups))
3244 (gnus-group-remove-mark group) 3263 (gnus-group-remove-mark group)
3245 (gnus-message 6 "Changed level of %s from %d to %d" 3264 (gnus-message 6 "Changed level of %s from %d to %d"
3246 group (or (gnus-group-group-level) gnus-level-killed) 3265 (gnus-group-decoded-name group)
3266 (or (gnus-group-group-level) gnus-level-killed)
3247 level) 3267 level)
3248 (gnus-group-change-level 3268 (gnus-group-change-level
3249 group level (or (gnus-group-group-level) gnus-level-killed)) 3269 group level (or (gnus-group-group-level) gnus-level-killed))
@@ -3392,7 +3412,7 @@ of groups killed."
3392 gnus-list-of-killed-groups)) 3412 gnus-list-of-killed-groups))
3393 (gnus-group-change-level 3413 (gnus-group-change-level
3394 (if entry entry group) gnus-level-killed (if entry nil level)) 3414 (if entry entry group) gnus-level-killed (if entry nil level))
3395 (message "Killed group %s" group)) 3415 (message "Killed group %s" (gnus-group-decoded-name group)))
3396 ;; If there are lots and lots of groups to be killed, we use 3416 ;; If there are lots and lots of groups to be killed, we use
3397 ;; this thing instead. 3417 ;; this thing instead.
3398 (dolist (group (nreverse groups)) 3418 (dolist (group (nreverse groups))
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index ff924139672..ef1c43167f5 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -1,5 +1,5 @@
1;;; gnus-spec.el --- format spec functions for Gnus 1;;; gnus-spec.el --- format spec functions for Gnus
2;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 2;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
3;; Free Software Foundation, Inc. 3;; Free Software Foundation, Inc.
4 4
5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -196,6 +196,13 @@ Return a list of updated types."
196 (not (equal emacs-version 196 (not (equal emacs-version
197 (cdr (assq 'version gnus-format-specs))))) 197 (cdr (assq 'version gnus-format-specs)))))
198 (setq gnus-format-specs nil)) 198 (setq gnus-format-specs nil))
199 ;; Flush the group format spec cache if it doesn't support decoded
200 ;; group names.
201 (when (memq 'group types)
202 (let ((spec (assq 'group gnus-format-specs)))
203 (unless (string-match " gnus-tmp-decoded-group[ )]"
204 (gnus-prin1-to-string (nth 2 spec)))
205 (setq gnus-format-specs (delq spec gnus-format-specs)))))
199 206
200 ;; Go through all the formats and see whether they need updating. 207 ;; Go through all the formats and see whether they need updating.
201 (let (new-format entry type val updated) 208 (let (new-format entry type val updated)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 8d6a5f951b5..17cb1ea2a6b 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -7254,11 +7254,12 @@ If BACKWARD, the previous article is selected instead of the next."
7254 (if (and group 7254 (if (and group
7255 (not (gnus-ephemeral-group-p gnus-newsgroup-name))) 7255 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
7256 (format " (Type %s for %s [%s])" 7256 (format " (Type %s for %s [%s])"
7257 (single-key-description cmd) group 7257 (single-key-description cmd)
7258 (gnus-group-decoded-name group)
7258 (car (gnus-gethash group gnus-newsrc-hashtb))) 7259 (car (gnus-gethash group gnus-newsrc-hashtb)))
7259 (format " (Type %s to exit %s)" 7260 (format " (Type %s to exit %s)"
7260 (single-key-description cmd) 7261 (single-key-description cmd)
7261 gnus-newsgroup-name)))) 7262 (gnus-group-decoded-name gnus-newsgroup-name)))))
7262 ;; Confirm auto selection. 7263 ;; Confirm auto selection.
7263 (setq key (car (setq keve (gnus-read-event-char prompt))) 7264 (setq key (car (setq keve (gnus-read-event-char prompt)))
7264 ended t) 7265 ended t)
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index a66c03908eb..ff7608e4a24 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -59,7 +59,7 @@
59 '((wget "wget" "--user-agent=mm-url" "-q" "-O" "-") 59 '((wget "wget" "--user-agent=mm-url" "-q" "-O" "-")
60 (w3m "w3m" "-dump_source") 60 (w3m "w3m" "-dump_source")
61 (lynx "lynx" "-source") 61 (lynx "lynx" "-source")
62 (curl "curl"))) 62 (curl "curl" "--silent")))
63 63
64(defcustom mm-url-program 64(defcustom mm-url-program
65 (cond 65 (cond
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 3be6444f18f..b8a739eeed6 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -57,9 +57,11 @@
57 mm-mime-mule-charset-alist) 57 mm-mime-mule-charset-alist)
58 nil t)))) 58 nil t))))
59 (subst-char-in-string 59 (subst-char-in-string
60 . (lambda (from to string) ;; stolen (and renamed) from nnheader.el 60 . (lambda (from to string &optional inplace)
61 "Replace characters in STRING from FROM to TO." 61 ;; stolen (and renamed) from nnheader.el
62 (let ((string (substring string 0)) ;Copy string. 62 "Replace characters in STRING from FROM to TO.
63 Unless optional argument INPLACE is non-nil, return a new string."
64 (let ((string (if inplace string (copy-sequence string)))
63 (len (length string)) 65 (len (length string))
64 (idx 0)) 66 (idx 0))
65 ;; Replace all occurrences of FROM with TO. 67 ;; Replace all occurrences of FROM with TO.
@@ -153,7 +155,7 @@ In XEmacs, also return non-nil if CS is a coding system object.
153If CS is available, return CS itself in Emacs, and return a coding 155If CS is available, return CS itself in Emacs, and return a coding
154system object in XEmacs." 156system object in XEmacs."
155 (if (fboundp 'find-coding-system) 157 (if (fboundp 'find-coding-system)
156 (find-coding-system cs) 158 (and cs (find-coding-system cs))
157 (if (fboundp 'coding-system-p) 159 (if (fboundp 'coding-system-p)
158 (when (coding-system-p cs) 160 (when (coding-system-p cs)
159 cs) 161 cs)
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 6ff2b46722e..006e309c3ff 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -1,5 +1,5 @@
1;;; nnrss.el --- interfacing with RSS 1;;; nnrss.el --- interfacing with RSS
2;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. 2;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
3 3
4;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> 4;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
5;; Keywords: RSS 5;; Keywords: RSS
@@ -36,9 +36,11 @@
36(require 'time-date) 36(require 'time-date)
37(require 'rfc2231) 37(require 'rfc2231)
38(require 'mm-url) 38(require 'mm-url)
39(require 'rfc2047)
40(require 'mml)
39(eval-when-compile 41(eval-when-compile
40 (ignore-errors 42 (ignore-errors
41 (require 'xml))) 43 (require 'xml)))
42(eval '(require 'xml)) 44(eval '(require 'xml))
43 45
44(nnoo-declare nnrss) 46(nnoo-declare nnrss)
@@ -75,20 +77,32 @@ To use the description in headers, put this name into `nnmail-extra-headers'.")
75(defvar nnrss-content-function nil 77(defvar nnrss-content-function nil
76 "A function which is called in `nnrss-request-article'. 78 "A function which is called in `nnrss-request-article'.
77The arguments are (ENTRY GROUP ARTICLE). 79The arguments are (ENTRY GROUP ARTICLE).
78ENTRY is the record of the current headline. GROUP is the group name. 80ENTRY is the record of the current headline. GROUP is the group name.
79ARTICLE is the article number of the current headline.") 81ARTICLE is the article number of the current headline.")
80 82
83(defvar nnrss-file-coding-system mm-universal-coding-system
84 "Coding system used when reading and writing files.")
85
86(defvar nnrss-compatible-encoding-alist '((iso-8859-1 . windows-1252))
87 "Alist of encodings and those supersets.
88The cdr of each element is used to decode data if it is available when
89the car is what the data specify as the encoding. Or, the car is used
90for decoding when the cdr that the data specify is not available.")
91
81(nnoo-define-basics nnrss) 92(nnoo-define-basics nnrss)
82 93
83;;; Interface functions 94;;; Interface functions
84 95
85(eval-when-compile 96(defsubst nnrss-format-string (string)
86 (defmacro nnrss-string-as-multibyte (string) 97 (gnus-replace-in-string string " *\n *" " "))
87 (if (featurep 'xemacs) 98
88 string 99(defun nnrss-decode-group-name (group)
89 `(string-as-multibyte ,string)))) 100 (if (and group (mm-coding-system-p 'utf-8))
101 (setq group (mm-decode-coding-string group 'utf-8))
102 group))
90 103
91(deffoo nnrss-retrieve-headers (articles &optional group server fetch-old) 104(deffoo nnrss-retrieve-headers (articles &optional group server fetch-old)
105 (setq group (nnrss-decode-group-name group))
92 (nnrss-possibly-change-group group server) 106 (nnrss-possibly-change-group group server)
93 (let (e) 107 (let (e)
94 (save-excursion 108 (save-excursion
@@ -97,21 +111,26 @@ ARTICLE is the article number of the current headline.")
97 (dolist (article articles) 111 (dolist (article articles)
98 (if (setq e (assq article nnrss-group-data)) 112 (if (setq e (assq article nnrss-group-data))
99 (insert (number-to-string (car e)) "\t" ;; number 113 (insert (number-to-string (car e)) "\t" ;; number
100 (if (nth 3 e) 114 ;; subject
101 (nnrss-format-string (nth 3 e)) "") 115 (or (nth 3 e) "")
102 "\t" ;; subject 116 "\t"
103 (if (nth 4 e) 117 ;; from
104 (nnrss-format-string (nth 4 e)) 118 (or (nth 4 e) "(nobody)")
105 "(nobody)") 119 "\t"
106 "\t" ;;from 120 ;; date
107 (or (nth 5 e) "") 121 (or (nth 5 e) "")
108 "\t" ;; date 122 "\t"
123 ;; id
109 (format "<%d@%s.nnrss>" (car e) group) 124 (format "<%d@%s.nnrss>" (car e) group)
110 "\t" ;; id 125 "\t"
111 "\t" ;; refs 126 ;; refs
112 "-1" "\t" ;; chars 127 "\t"
113 "-1" "\t" ;; lines 128 ;; chars
114 "" "\t" ;; Xref 129 "-1" "\t"
130 ;; lines
131 "-1" "\t"
132 ;; Xref
133 "" "\t"
115 (if (and (nth 6 e) 134 (if (and (nth 6 e)
116 (memq nnrss-description-field 135 (memq nnrss-description-field
117 nnmail-extra-headers)) 136 nnmail-extra-headers))
@@ -132,69 +151,102 @@ ARTICLE is the article number of the current headline.")
132 'nov) 151 'nov)
133 152
134(deffoo nnrss-request-group (group &optional server dont-check) 153(deffoo nnrss-request-group (group &optional server dont-check)
154 (setq group (nnrss-decode-group-name group))
155 (nnheader-message 6 "nnrss: Requesting %s..." group)
135 (nnrss-possibly-change-group group server) 156 (nnrss-possibly-change-group group server)
136 (if dont-check 157 (prog1
137 t 158 (if dont-check
138 (nnrss-check-group group server) 159 t
139 (nnheader-report 'nnrss "Opened group %s" group) 160 (nnrss-check-group group server)
140 (nnheader-insert 161 (nnheader-report 'nnrss "Opened group %s" group)
141 "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max 162 (nnheader-insert
142 (prin1-to-string group) 163 "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max
143 t))) 164 (prin1-to-string group)
165 t))
166 (nnheader-message 6 "nnrss: Requesting %s...done" group)))
144 167
145(deffoo nnrss-close-group (group &optional server) 168(deffoo nnrss-close-group (group &optional server)
146 t) 169 t)
147 170
148(deffoo nnrss-request-article (article &optional group server buffer) 171(deffoo nnrss-request-article (article &optional group server buffer)
172 (setq group (nnrss-decode-group-name group))
173 (when (stringp article)
174 (setq article (if (string-match "\\`<\\([0-9]+\\)@" article)
175 (string-to-number (match-string 1 article))
176 0)))
149 (nnrss-possibly-change-group group server) 177 (nnrss-possibly-change-group group server)
150 (let ((e (assq article nnrss-group-data)) 178 (let ((e (assq article nnrss-group-data))
151 (boundary "=-=-=-=-=-=-=-=-=-")
152 (nntp-server-buffer (or buffer nntp-server-buffer)) 179 (nntp-server-buffer (or buffer nntp-server-buffer))
153 post err) 180 post err)
154 (when e 181 (when e
155 (catch 'error 182 (with-current-buffer nntp-server-buffer
156 (with-current-buffer nntp-server-buffer 183 (erase-buffer)
157 (erase-buffer) 184 (if group
158 (goto-char (point-min)) 185 (insert "Newsgroups: " group "\n"))
159 (insert "Mime-Version: 1.0\nContent-Type: multipart/alternative; boundary=\"" boundary "\"\n") 186 (if (nth 3 e)
160 (if group 187 (insert "Subject: " (nth 3 e) "\n"))
161 (insert "Newsgroups: " group "\n")) 188 (if (nth 4 e)
162 (if (nth 3 e) 189 (insert "From: " (nth 4 e) "\n"))
163 (insert "Subject: " (nnrss-format-string (nth 3 e)) "\n")) 190 (if (nth 5 e)
164 (if (nth 4 e) 191 (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
165 (insert "From: " (nnrss-format-string (nth 4 e)) "\n")) 192 (let ((header (buffer-string))
166 (if (nth 5 e) 193 (text (if (nth 6 e)
167 (insert "Date: " (nnrss-format-string (nth 5 e)) "\n")) 194 (mapconcat 'identity
168 (insert "Message-ID: " (format "<%d@%s.nnrss>" (car e) group) "\n") 195 (delete "" (split-string (nth 6 e) "\n+"))
169 (insert "\n") 196 " ")))
170 (let ((text (if (nth 6 e) 197 (link (nth 2 e))
171 (nnrss-string-as-multibyte (nth 6 e)))) 198 ;; Enable encoding of Newsgroups header in XEmacs.
172 (link (if (nth 2 e) 199 (default-enable-multibyte-characters t)
173 (nth 2 e)))) 200 (rfc2047-header-encoding-alist
174 (insert "\n\n--" boundary "\nContent-Type: text/plain\n\n") 201 (if (mm-coding-system-p 'utf-8)
175 (let ((point (point))) 202 (cons '("Newsgroups" . utf-8)
176 (if text 203 rfc2047-header-encoding-alist)
177 (progn (insert text) 204 rfc2047-header-encoding-alist))
178 (goto-char point) 205 rfc2047-encode-encoded-words body)
179 (while (re-search-forward "\n" nil t) 206 (when (or text link)
180 (replace-match " ")) 207 (insert "\n")
181 (goto-char (point-max)) 208 (insert "<#multipart type=alternative>\n"
182 (insert "\n\n"))) 209 "<#part type=\"text/plain\">\n")
183 (if link 210 (setq body (point))
184 (insert link))) 211 (if text
185 (insert "\n\n--" boundary "\nContent-Type: text/html\n\n") 212 (progn
186 (let ((point (point))) 213 (insert text "\n")
187 (if text 214 (when link
188 (progn (insert "<html><head></head><body>\n" text "\n</body></html>") 215 (insert "\n" link "\n")))
189 (goto-char point) 216 (when link
190 (while (re-search-forward "\n" nil t) 217 (insert link "\n")))
191 (replace-match " ")) 218 (setq body (buffer-substring body (point)))
192 (goto-char (point-max)) 219 (insert "<#/part>\n"
193 (insert "\n\n"))) 220 "<#part type=\"text/html\">\n"
194 (if link 221 "<html><head></head><body>\n")
195 (insert "<p><a href=\"" link "\">link</a></p>\n")))) 222 (when text
196 (if nnrss-content-function 223 (insert text "\n"))
197 (funcall nnrss-content-function e group article))))) 224 (when link
225 (insert "<p><a href=\"" link "\">link</a></p>\n"))
226 (insert "</body></html>\n"
227 "<#/part>\n"
228 "<#/multipart>\n"))
229 (condition-case nil
230 (mml-to-mime)
231 (error
232 (erase-buffer)
233 (insert header
234 "Content-Type: text/plain; charset=gnus-decoded\n"
235 "Content-Transfer-Encoding: 8bit\n\n"
236 body)
237 (nnheader-message
238 3 "Warning - there might be invalid characters"))))
239 (goto-char (point-min))
240 (search-forward "\n\n")
241 (forward-line -1)
242 (insert (format "Message-ID: <%d@%s.nnrss>\n"
243 (car e)
244 (let ((rfc2047-encoding-type 'mime)
245 rfc2047-encode-max-chars)
246 (rfc2047-encode-string
247 (gnus-replace-in-string group "[\t\n ]+" "_")))))
248 (when nnrss-content-function
249 (funcall nnrss-content-function e group article))))
198 (cond 250 (cond
199 (err 251 (err
200 (nnheader-report 'nnrss err)) 252 (nnheader-report 'nnrss err))
@@ -217,6 +269,7 @@ ARTICLE is the article number of the current headline.")
217 269
218(deffoo nnrss-request-expire-articles 270(deffoo nnrss-request-expire-articles
219 (articles group &optional server force) 271 (articles group &optional server force)
272 (setq group (nnrss-decode-group-name group))
220 (nnrss-possibly-change-group group server) 273 (nnrss-possibly-change-group group server)
221 (let (e days not-expirable changed) 274 (let (e days not-expirable changed)
222 (dolist (art articles) 275 (dolist (art articles)
@@ -234,18 +287,18 @@ ARTICLE is the article number of the current headline.")
234 not-expirable)) 287 not-expirable))
235 288
236(deffoo nnrss-request-delete-group (group &optional force server) 289(deffoo nnrss-request-delete-group (group &optional force server)
290 (setq group (nnrss-decode-group-name group))
237 (nnrss-possibly-change-group group server) 291 (nnrss-possibly-change-group group server)
292 (let (elem)
293 ;; There may be two or more entries in `nnrss-group-alist' since
294 ;; this function didn't delete them formerly.
295 (while (setq elem (assoc group nnrss-group-alist))
296 (setq nnrss-group-alist (delq elem nnrss-group-alist))))
238 (setq nnrss-server-data 297 (setq nnrss-server-data
239 (delq (assoc group nnrss-server-data) nnrss-server-data)) 298 (delq (assoc group nnrss-server-data) nnrss-server-data))
240 (nnrss-save-server-data server) 299 (nnrss-save-server-data server)
241 (let ((file (expand-file-name 300 (ignore-errors
242 (nnrss-translate-file-chars 301 (delete-file (nnrss-make-filename group server)))
243 (concat group (and server
244 (not (equal server ""))
245 "-")
246 server ".el")) nnrss-directory)))
247 (ignore-errors
248 (delete-file file)))
249 t) 302 t)
250 303
251(deffoo nnrss-request-list-newsgroups (&optional server) 304(deffoo nnrss-request-list-newsgroups (&optional server)
@@ -262,34 +315,67 @@ ARTICLE is the article number of the current headline.")
262 315
263;;; Internal functions 316;;; Internal functions
264(eval-when-compile (defun xml-rpc-method-call (&rest args))) 317(eval-when-compile (defun xml-rpc-method-call (&rest args)))
318
319(defun nnrss-get-encoding ()
320 "Return an encoding attribute specified in the current xml contents.
321If `nnrss-compatible-encoding-alist' specifies the compatible encoding,
322it is used instead. If the xml contents doesn't specify the encoding,
323return `utf-8' which is the default encoding for xml if it is available,
324otherwise return nil."
325 (goto-char (point-min))
326 (if (re-search-forward
327 "<\\?[^>]*encoding=\\(\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)"
328 nil t)
329 (let ((encoding (intern (downcase (or (match-string 2)
330 (match-string 3))))))
331 (or
332 (mm-coding-system-p (cdr (assq encoding
333 nnrss-compatible-encoding-alist)))
334 (mm-coding-system-p encoding)
335 (mm-coding-system-p (car (rassq encoding
336 nnrss-compatible-encoding-alist)))))
337 (mm-coding-system-p 'utf-8)))
338
265(defun nnrss-fetch (url &optional local) 339(defun nnrss-fetch (url &optional local)
266 "Fetch the url and put it in a the expected lisp structure." 340 "Fetch URL and put it in a the expected Lisp structure."
267 (with-temp-buffer 341 (mm-with-unibyte-buffer
268 ;some CVS versions of url.el need this to close the connection quickly 342 ;;some CVS versions of url.el need this to close the connection quickly
269 (let* (xmlform htmlform) 343 (let (cs xmlform htmlform)
270 ;; bit o' work necessary for w3 pre-cvs and post-cvs 344 ;; bit o' work necessary for w3 pre-cvs and post-cvs
271 (if local 345 (if local
272 (let ((coding-system-for-read 'binary)) 346 (let ((coding-system-for-read 'binary))
273 (insert-file-contents url)) 347 (insert-file-contents url))
274 (mm-url-insert url)) 348 ;; FIXME: shouldn't binding `coding-system-for-read' be moved
275 349 ;; to `mm-url-insert'?
276;; Because xml-parse-region can't deal with anything that isn't 350 (let ((coding-system-for-read 'binary))
277;; xml and w3-parse-buffer can't deal with some xml, we have to 351 (mm-url-insert url)))
278;; parse with xml-parse-region first and, if that fails, parse 352 (nnheader-remove-cr-followed-by-lf)
279;; with w3-parse-buffer. Yuck. Eventually, someone should find out 353 ;; Decode text according to the encoding attribute.
280;; why w3-parse-buffer fails to parse some well-formed xml and 354 (when (setq cs (nnrss-get-encoding))
281;; fix it. 355 (mm-decode-coding-region (point-min) (point-max) cs)
282 356 (mm-enable-multibyte))
283 (condition-case err 357 (goto-char (point-min))
284 (setq xmlform (xml-parse-region (point-min) (point-max))) 358
285 (error (if (fboundp 'w3-parse-buffer) 359 ;; Because xml-parse-region can't deal with anything that isn't
286 (setq htmlform (caddar (w3-parse-buffer 360 ;; xml and w3-parse-buffer can't deal with some xml, we have to
287 (current-buffer)))) 361 ;; parse with xml-parse-region first and, if that fails, parse
288 (message "nnrss: Not valid XML and w3 parse not available (%s)" 362 ;; with w3-parse-buffer. Yuck. Eventually, someone should find out
289 url)))) 363 ;; why w3-parse-buffer fails to parse some well-formed xml and
290 (if htmlform 364 ;; fix it.
291 htmlform 365
292 xmlform)))) 366 (condition-case err1
367 (setq xmlform (xml-parse-region (point-min) (point-max)))
368 (error
369 (condition-case err2
370 (setq htmlform (caddar (w3-parse-buffer
371 (current-buffer))))
372 (error
373 (message "\
374nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
375 url err1 err2)))))
376 (if htmlform
377 htmlform
378 xmlform))))
293 379
294(defun nnrss-possibly-change-group (&optional group server) 380(defun nnrss-possibly-change-group (&optional group server)
295 (when (and server 381 (when (and server
@@ -302,9 +388,9 @@ ARTICLE is the article number of the current headline.")
302(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories)) 388(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories))
303 389
304(defun nnrss-generate-active () 390(defun nnrss-generate-active ()
305 (if (y-or-n-p "fetch extra categories? ") 391 (when (y-or-n-p "Fetch extra categories? ")
306 (dolist (func nnrss-extra-categories) 392 (dolist (func nnrss-extra-categories)
307 (funcall func))) 393 (funcall func)))
308 (save-excursion 394 (save-excursion
309 (set-buffer nntp-server-buffer) 395 (set-buffer nntp-server-buffer)
310 (erase-buffer) 396 (erase-buffer)
@@ -318,41 +404,26 @@ ARTICLE is the article number of the current headline.")
318 404
319(defun nnrss-read-server-data (server) 405(defun nnrss-read-server-data (server)
320 (setq nnrss-server-data nil) 406 (setq nnrss-server-data nil)
321 (let ((file (expand-file-name 407 (let ((file (nnrss-make-filename "nnrss" server)))
322 (nnrss-translate-file-chars
323 (concat "nnrss" (and server
324 (not (equal server ""))
325 "-")
326 server
327 ".el"))
328 nnrss-directory)))
329 (when (file-exists-p file) 408 (when (file-exists-p file)
330 (with-temp-buffer 409 ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
331 (let ((coding-system-for-read 'binary) 410 ;; file names. So, we use `insert-file-contents' instead.
332 emacs-lisp-mode-hook) 411 (mm-with-multibyte-buffer
412 (let ((coding-system-for-read nnrss-file-coding-system)
413 (file-name-coding-system nnmail-pathname-coding-system))
333 (insert-file-contents file) 414 (insert-file-contents file)
334 (emacs-lisp-mode) 415 (eval-region (point-min) (point-max)))))))
335 (goto-char (point-min))
336 (eval-buffer))))))
337 416
338(defun nnrss-save-server-data (server) 417(defun nnrss-save-server-data (server)
339 (gnus-make-directory nnrss-directory) 418 (gnus-make-directory nnrss-directory)
340 (let ((file (expand-file-name 419 (let ((coding-system-for-write nnrss-file-coding-system)
341 (nnrss-translate-file-chars 420 (file-name-coding-system nnmail-pathname-coding-system))
342 (concat "nnrss" (and server 421 (with-temp-file (nnrss-make-filename "nnrss" server)
343 (not (equal server "")) 422 (insert (format ";; -*- coding: %s; -*-\n"
344 "-") 423 nnrss-file-coding-system))
345 server ".el")) 424 (gnus-prin1 `(setq nnrss-group-alist ',nnrss-group-alist))
346 nnrss-directory))) 425 (insert "\n")
347 (let ((coding-system-for-write 'binary) 426 (gnus-prin1 `(setq nnrss-server-data ',nnrss-server-data)))))
348 print-level print-length)
349 (with-temp-file file
350 (insert "(setq nnrss-group-alist '"
351 (prin1-to-string nnrss-group-alist)
352 ")\n")
353 (insert "(setq nnrss-server-data '"
354 (prin1-to-string nnrss-server-data)
355 ")\n")))))
356 427
357(defun nnrss-read-group-data (group server) 428(defun nnrss-read-group-data (group server)
358 (setq nnrss-group-data nil) 429 (setq nnrss-group-data nil)
@@ -360,43 +431,50 @@ ARTICLE is the article number of the current headline.")
360 (let ((pair (assoc group nnrss-server-data))) 431 (let ((pair (assoc group nnrss-server-data)))
361 (setq nnrss-group-max (or (cadr pair) 0)) 432 (setq nnrss-group-max (or (cadr pair) 0))
362 (setq nnrss-group-min (+ nnrss-group-max 1))) 433 (setq nnrss-group-min (+ nnrss-group-max 1)))
363 (let ((file (expand-file-name 434 (let ((file (nnrss-make-filename group server)))
364 (nnrss-translate-file-chars
365 (concat group (and server
366 (not (equal server ""))
367 "-")
368 server ".el"))
369 nnrss-directory)))
370 (when (file-exists-p file) 435 (when (file-exists-p file)
371 (with-temp-buffer 436 ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
372 (let ((coding-system-for-read 'binary) 437 ;; file names. So, we use `insert-file-contents' instead.
373 emacs-lisp-mode-hook) 438 (mm-with-multibyte-buffer
439 (let ((coding-system-for-read nnrss-file-coding-system)
440 (file-name-coding-system nnmail-pathname-coding-system))
374 (insert-file-contents file) 441 (insert-file-contents file)
375 (emacs-lisp-mode) 442 (eval-region (point-min) (point-max))))
376 (goto-char (point-min))
377 (eval-buffer)))
378 (dolist (e nnrss-group-data) 443 (dolist (e nnrss-group-data)
379 (gnus-sethash (nth 2 e) e nnrss-group-hashtb) 444 (gnus-sethash (or (nth 2 e) (nth 6 e)) t nnrss-group-hashtb)
380 (if (and (car e) (> nnrss-group-min (car e))) 445 (when (and (car e) (> nnrss-group-min (car e)))
381 (setq nnrss-group-min (car e))) 446 (setq nnrss-group-min (car e)))
382 (if (and (car e) (< nnrss-group-max (car e))) 447 (when (and (car e) (< nnrss-group-max (car e)))
383 (setq nnrss-group-max (car e))))))) 448 (setq nnrss-group-max (car e)))))))
384 449
385(defun nnrss-save-group-data (group server) 450(defun nnrss-save-group-data (group server)
386 (gnus-make-directory nnrss-directory) 451 (gnus-make-directory nnrss-directory)
387 (let ((file (expand-file-name 452 (let ((coding-system-for-write nnrss-file-coding-system)
388 (nnrss-translate-file-chars 453 (file-name-coding-system nnmail-pathname-coding-system))
389 (concat group (and server 454 (with-temp-file (nnrss-make-filename group server)
390 (not (equal server "")) 455 (insert (format ";; -*- coding: %s; -*-\n"
391 "-") 456 nnrss-file-coding-system))
392 server ".el")) 457 (gnus-prin1 `(setq nnrss-group-data ',nnrss-group-data)))))
393 nnrss-directory))) 458
394 (let ((coding-system-for-write 'binary) 459(defun nnrss-make-filename (name server)
395 print-level print-length) 460 (expand-file-name
396 (with-temp-file file 461 (nnrss-translate-file-chars
397 (insert "(setq nnrss-group-data '" 462 (concat name
398 (prin1-to-string nnrss-group-data) 463 (and server
399 ")\n"))))) 464 (not (equal server ""))
465 "-")
466 server
467 ".el"))
468 nnrss-directory))
469
470(gnus-add-shutdown 'nnrss-close 'gnus)
471
472(defun nnrss-close ()
473 "Clear internal nnrss variables."
474 (setq nnrss-group-data nil
475 nnrss-server-data nil
476 nnrss-group-hashtb nil
477 nnrss-group-alist nil))
400 478
401;;; URL interface 479;;; URL interface
402 480
@@ -407,15 +485,36 @@ ARTICLE is the article number of the current headline.")
407 (mm-with-unibyte-current-buffer 485 (mm-with-unibyte-current-buffer
408 (mm-url-insert url))) 486 (mm-url-insert url)))
409 487
410(defun nnrss-decode-entities-unibyte-string (string) 488(defun nnrss-decode-entities-string (string)
411 (if string 489 (if string
412 (mm-with-unibyte-buffer 490 (mm-with-multibyte-buffer
413 (insert string) 491 (insert string)
414 (mm-url-decode-entities-nbsp) 492 (mm-url-decode-entities-nbsp)
415 (buffer-string)))) 493 (buffer-string))))
416 494
417(defalias 'nnrss-insert 'nnrss-insert-w3) 495(defalias 'nnrss-insert 'nnrss-insert-w3)
418 496
497(defun nnrss-mime-encode-string (string)
498 (mm-with-multibyte-buffer
499 (insert string)
500 (mm-url-decode-entities-nbsp)
501 (goto-char (point-min))
502 (while (re-search-forward "[\t\n ]+" nil t)
503 (replace-match " "))
504 (goto-char (point-min))
505 (skip-chars-forward " ")
506 (delete-region (point-min) (point))
507 (goto-char (point-max))
508 (skip-chars-forward " ")
509 (delete-region (point) (point-max))
510 (let ((rfc2047-encoding-type 'mime)
511 rfc2047-encode-max-chars)
512 (rfc2047-encode-region (point-min) (point-max)))
513 (goto-char (point-min))
514 (while (search-forward "\n" nil t)
515 (delete-backward-char 1))
516 (buffer-string)))
517
419;;; Snarf functions 518;;; Snarf functions
420 519
421(defun nnrss-check-group (group server) 520(defun nnrss-check-group (group server)
@@ -431,11 +530,11 @@ ARTICLE is the article number of the current headline.")
431 (second (assoc group nnrss-group-alist)))) 530 (second (assoc group nnrss-group-alist))))
432 (unless url 531 (unless url
433 (setq url 532 (setq url
434 (cdr 533 (cdr
435 (assoc 'href 534 (assoc 'href
436 (nnrss-discover-feed 535 (nnrss-discover-feed
437 (read-string 536 (read-string
438 (format "URL to search for %s: " group) "http://"))))) 537 (format "URL to search for %s: " group) "http://")))))
439 (let ((pair (assoc group nnrss-server-data))) 538 (let ((pair (assoc group nnrss-server-data)))
440 (if pair 539 (if pair
441 (setcdr (cdr pair) (list url)) 540 (setcdr (cdr pair) (list url))
@@ -451,12 +550,16 @@ ARTICLE is the article number of the current headline.")
451 content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/")) 550 content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/"))
452 (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml))) 551 (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml)))
453 (when (and (listp item) 552 (when (and (listp item)
454 (eq (intern (concat rss-ns "item")) (car item)) 553 (string= (concat rss-ns "item") (car item))
455 (setq url (nnrss-decode-entities-unibyte-string 554 (if (setq url (nnrss-decode-entities-string
456 (nnrss-node-text rss-ns 'link (cddr item)))) 555 (nnrss-node-text rss-ns 'link (cddr item))))
457 (not (gnus-gethash url nnrss-group-hashtb))) 556 (not (gnus-gethash url nnrss-group-hashtb))
557 (setq extra (or (nnrss-node-text content-ns 'encoded item)
558 (nnrss-node-text rss-ns 'description item)))
559 (not (gnus-gethash extra nnrss-group-hashtb))))
458 (setq subject (nnrss-node-text rss-ns 'title item)) 560 (setq subject (nnrss-node-text rss-ns 'title item))
459 (setq extra (or (nnrss-node-text content-ns 'encoded item) 561 (setq extra (or extra
562 (nnrss-node-text content-ns 'encoded item)
460 (nnrss-node-text rss-ns 'description item))) 563 (nnrss-node-text rss-ns 'description item)))
461 (setq author (or (nnrss-node-text rss-ns 'author item) 564 (setq author (or (nnrss-node-text rss-ns 'author item)
462 (nnrss-node-text dc-ns 'creator item) 565 (nnrss-node-text dc-ns 'creator item)
@@ -469,13 +572,14 @@ ARTICLE is the article number of the current headline.")
469 (incf nnrss-group-max) 572 (incf nnrss-group-max)
470 (current-time) 573 (current-time)
471 url 574 url
472 (and subject (nnrss-decode-entities-unibyte-string subject)) 575 (and subject (nnrss-mime-encode-string subject))
473 (and author (nnrss-decode-entities-unibyte-string author)) 576 (and author (nnrss-mime-encode-string author))
474 date 577 date
475 (and extra (nnrss-decode-entities-unibyte-string extra))) 578 (and extra (nnrss-decode-entities-string extra)))
476 nnrss-group-data) 579 nnrss-group-data)
477 (gnus-sethash url (car nnrss-group-data) nnrss-group-hashtb) 580 (gnus-sethash (or url extra) t nnrss-group-hashtb)
478 (setq changed t))) 581 (setq changed t))
582 (setq extra nil))
479 (when changed 583 (when changed
480 (nnrss-save-group-data group server) 584 (nnrss-save-group-data group server)
481 (let ((pair (assoc group nnrss-server-data))) 585 (let ((pair (assoc group nnrss-server-data)))
@@ -484,6 +588,45 @@ ARTICLE is the article number of the current headline.")
484 (push (list group nnrss-group-max) nnrss-server-data))) 588 (push (list group nnrss-group-max) nnrss-server-data)))
485 (nnrss-save-server-data server)))) 589 (nnrss-save-server-data server))))
486 590
591(defun nnrss-opml-import (opml-file)
592 "OPML subscriptions import.
593Read the file and attempt to subscribe to each Feed in the file."
594 (interactive "fImport file: ")
595 (mapcar
596 (lambda (node) (gnus-group-make-rss-group
597 (cdr (assq 'xmlUrl (cadr node)))))
598 (nnrss-find-el 'outline
599 (progn
600 (find-file opml-file)
601 (xml-parse-region (point-min)
602 (point-max))))))
603
604(defun nnrss-opml-export ()
605 "OPML subscription export.
606Export subscriptions to a buffer in OPML Format."
607 (interactive)
608 (with-current-buffer (get-buffer-create "*OPML Export*")
609 (mm-set-buffer-file-coding-system 'utf-8)
610 (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
611 "<!-- OPML generated by Emacs Gnus' nnrss.el -->\n"
612 "<opml version=\"1.1\">\n"
613 " <head>\n"
614 " <title>mySubscriptions</title>\n"
615 " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
616 "</dateCreated>\n"
617 " <ownerEmail>" user-mail-address "</ownerEmail>\n"
618 " <ownerName>" (user-full-name) "</ownerName>\n"
619 " </head>\n"
620 " <body>\n")
621 (dolist (sub nnrss-group-alist)
622 (insert " <outline text=\"" (car sub)
623 "\" xmlUrl=\"" (cadr sub) "\"/>\n"))
624 (insert " </body>\n"
625 "</opml>\n"))
626 (pop-to-buffer "*OPML Export*")
627 (when (fboundp 'sgml-mode)
628 (sgml-mode)))
629
487(defun nnrss-generate-download-script () 630(defun nnrss-generate-download-script ()
488 "Generate a download script in the current buffer. 631 "Generate a download script in the current buffer.
489It is useful when `(setq nnrss-use-local t)'." 632It is useful when `(setq nnrss-use-local t)'."
@@ -530,9 +673,6 @@ It is useful when `(setq nnrss-use-local t)'."
530 (if changed 673 (if changed
531 (nnrss-save-server-data "")))) 674 (nnrss-save-server-data ""))))
532 675
533(defun nnrss-format-string (string)
534 (gnus-replace-in-string (nnrss-string-as-multibyte string) " *\n *" " "))
535
536(defun nnrss-node-text (namespace local-name element) 676(defun nnrss-node-text (namespace local-name element)
537 (let* ((node (assq (intern (concat namespace (symbol-name local-name))) 677 (let* ((node (assq (intern (concat namespace (symbol-name local-name)))
538 element)) 678 element))
@@ -551,56 +691,59 @@ It is useful when `(setq nnrss-use-local t)'."
551 node)) 691 node))
552 692
553(defun nnrss-find-el (tag data &optional found-list) 693(defun nnrss-find-el (tag data &optional found-list)
554 "Find the all matching elements in the data. Careful with this on 694 "Find the all matching elements in the data.
555large documents!" 695Careful with this on large documents!"
556 (if (listp data) 696 (when (consp data)
557 (mapcar (lambda (bit) 697 (dolist (bit data)
558 (if (car-safe bit) 698 (when (car-safe bit)
559 (progn (if (equal tag (car bit)) 699 (when (equal tag (car bit))
560 (setq found-list 700 ;; Old xml.el may return a list of string.
561 (append found-list 701 (when (and (consp (caddr bit))
562 (list bit)))) 702 (stringp (caaddr bit)))
563 (if (and (listp (car-safe (caddr bit))) 703 (setcar (cddr bit) (caaddr bit)))
564 (not (stringp (caddr bit)))) 704 (setq found-list
565 (setq found-list 705 (append found-list
566 (append found-list 706 (list bit))))
567 (nnrss-find-el 707 (if (and (consp (car-safe (caddr bit)))
568 tag (caddr bit)))) 708 (not (stringp (caddr bit))))
569 (setq found-list 709 (setq found-list
570 (append found-list 710 (append found-list
571 (nnrss-find-el 711 (nnrss-find-el
572 tag (cddr bit)))))))) 712 tag (caddr bit))))
573 data)) 713 (setq found-list
714 (append found-list
715 (nnrss-find-el
716 tag (cddr bit))))))))
574 found-list) 717 found-list)
575 718
576(defun nnrss-rsslink-p (el) 719(defun nnrss-rsslink-p (el)
577 "Test if the element we are handed is an RSS autodiscovery link." 720 "Test if the element we are handed is an RSS autodiscovery link."
578 (and (eq (car-safe el) 'link) 721 (and (eq (car-safe el) 'link)
579 (string-equal (cdr (assoc 'rel (cadr el))) "alternate") 722 (string-equal (cdr (assoc 'rel (cadr el))) "alternate")
580 (or (string-equal (cdr (assoc 'type (cadr el))) 723 (or (string-equal (cdr (assoc 'type (cadr el)))
581 "application/rss+xml") 724 "application/rss+xml")
582 (string-equal (cdr (assoc 'type (cadr el))) "text/xml")))) 725 (string-equal (cdr (assoc 'type (cadr el))) "text/xml"))))
583 726
584(defun nnrss-get-rsslinks (data) 727(defun nnrss-get-rsslinks (data)
585 "Extract the <link> elements that are links to RSS from the parsed data." 728 "Extract the <link> elements that are links to RSS from the parsed data."
586 (delq nil (mapcar 729 (delq nil (mapcar
587 (lambda (el) 730 (lambda (el)
588 (if (nnrss-rsslink-p el) el)) 731 (if (nnrss-rsslink-p el) el))
589 (nnrss-find-el 'link data)))) 732 (nnrss-find-el 'link data))))
590 733
591(defun nnrss-extract-hrefs (data) 734(defun nnrss-extract-hrefs (data)
592 "Recursively extract hrefs from a page's source. DATA should be 735 "Recursively extract hrefs from a page's source.
593the output of xml-parse-region or w3-parse-buffer." 736DATA should be the output of `xml-parse-region' or
737`w3-parse-buffer'."
594 (mapcar (lambda (ahref) 738 (mapcar (lambda (ahref)
595 (cdr (assoc 'href (cadr ahref)))) 739 (cdr (assoc 'href (cadr ahref))))
596 (nnrss-find-el 'a data))) 740 (nnrss-find-el 'a data)))
597 741
598(defmacro nnrss-match-macro (base-uri item 742(defmacro nnrss-match-macro (base-uri item onsite-list offsite-list)
599 onsite-list offsite-list)
600 `(cond ((or (string-match (concat "^" ,base-uri) ,item) 743 `(cond ((or (string-match (concat "^" ,base-uri) ,item)
601 (not (string-match "://" ,item))) 744 (not (string-match "://" ,item)))
602 (setq ,onsite-list (append ,onsite-list (list ,item)))) 745 (setq ,onsite-list (append ,onsite-list (list ,item))))
603 (t (setq ,offsite-list (append ,offsite-list (list ,item)))))) 746 (t (setq ,offsite-list (append ,offsite-list (list ,item))))))
604 747
605(defun nnrss-order-hrefs (base-uri hrefs) 748(defun nnrss-order-hrefs (base-uri hrefs)
606 "Given a list of hrefs, sort them using the following priorities: 749 "Given a list of hrefs, sort them using the following priorities:
@@ -615,29 +758,28 @@ whether they are `offsite' or `onsite'."
615 (let (rss-onsite-end rdf-onsite-end xml-onsite-end 758 (let (rss-onsite-end rdf-onsite-end xml-onsite-end
616 rss-onsite-in rdf-onsite-in xml-onsite-in 759 rss-onsite-in rdf-onsite-in xml-onsite-in
617 rss-offsite-end rdf-offsite-end xml-offsite-end 760 rss-offsite-end rdf-offsite-end xml-offsite-end
618 rss-offsite-in rdf-offsite-in xml-offsite-in) 761 rss-offsite-in rdf-offsite-in xml-offsite-in)
619 (mapcar (lambda (href) 762 (dolist (href hrefs)
620 (if (not (null href)) 763 (cond ((null href))
621 (cond ((string-match "\\.rss$" href) 764 ((string-match "\\.rss$" href)
622 (nnrss-match-macro 765 (nnrss-match-macro
623 base-uri href rss-onsite-end rss-offsite-end)) 766 base-uri href rss-onsite-end rss-offsite-end))
624 ((string-match "\\.rdf$" href) 767 ((string-match "\\.rdf$" href)
625 (nnrss-match-macro 768 (nnrss-match-macro
626 base-uri href rdf-onsite-end rdf-offsite-end)) 769 base-uri href rdf-onsite-end rdf-offsite-end))
627 ((string-match "\\.xml$" href) 770 ((string-match "\\.xml$" href)
628 (nnrss-match-macro 771 (nnrss-match-macro
629 base-uri href xml-onsite-end xml-offsite-end)) 772 base-uri href xml-onsite-end xml-offsite-end))
630 ((string-match "rss" href) 773 ((string-match "rss" href)
631 (nnrss-match-macro 774 (nnrss-match-macro
632 base-uri href rss-onsite-in rss-offsite-in)) 775 base-uri href rss-onsite-in rss-offsite-in))
633 ((string-match "rdf" href) 776 ((string-match "rdf" href)
634 (nnrss-match-macro 777 (nnrss-match-macro
635 base-uri href rdf-onsite-in rdf-offsite-in)) 778 base-uri href rdf-onsite-in rdf-offsite-in))
636 ((string-match "xml" href) 779 ((string-match "xml" href)
637 (nnrss-match-macro 780 (nnrss-match-macro
638 base-uri href xml-onsite-in xml-offsite-in))))) 781 base-uri href xml-onsite-in xml-offsite-in))))
639 hrefs) 782 (append
640 (append
641 rss-onsite-end rdf-onsite-end xml-onsite-end 783 rss-onsite-end rdf-onsite-end xml-onsite-end
642 rss-onsite-in rdf-onsite-in xml-onsite-in 784 rss-onsite-in rdf-onsite-in xml-onsite-in
643 rss-offsite-end rdf-offsite-end xml-offsite-end 785 rss-offsite-end rdf-offsite-end xml-offsite-end
@@ -670,23 +812,23 @@ whether they are `offsite' or `onsite'."
670;; - offsite links containing any of the above 812;; - offsite links containing any of the above
671 (let* ((base-uri (progn (string-match ".*://[^/]+/?" url) 813 (let* ((base-uri (progn (string-match ".*://[^/]+/?" url)
672 (match-string 0 url))) 814 (match-string 0 url)))
673 (hrefs (nnrss-order-hrefs 815 (hrefs (nnrss-order-hrefs
674 base-uri (nnrss-extract-hrefs parsed-page))) 816 base-uri (nnrss-extract-hrefs parsed-page)))
675 (rss-link nil)) 817 (rss-link nil))
676 (while (and (eq rss-link nil) (not (eq hrefs nil))) 818 (while (and (eq rss-link nil) (not (eq hrefs nil)))
677 (let ((href-data (nnrss-fetch (car hrefs)))) 819 (let ((href-data (nnrss-fetch (car hrefs))))
678 (if (nnrss-rss-p href-data) 820 (if (nnrss-rss-p href-data)
679 (let* ((rss-ns (nnrss-get-namespace-prefix href-data "http://purl.org/rss/1.0/"))) 821 (let* ((rss-ns (nnrss-get-namespace-prefix href-data "http://purl.org/rss/1.0/")))
680 (setq rss-link (nnrss-rss-title-description 822 (setq rss-link (nnrss-rss-title-description
681 rss-ns href-data (car hrefs)))) 823 rss-ns href-data (car hrefs))))
682 (setq hrefs (cdr hrefs))))) 824 (setq hrefs (cdr hrefs)))))
683 (if rss-link rss-link 825 (if rss-link rss-link
684 826
685;; 4. check syndic8 827;; 4. check syndic8
686 (nnrss-find-rss-via-syndic8 url)))))))) 828 (nnrss-find-rss-via-syndic8 url))))))))
687 829
688(defun nnrss-find-rss-via-syndic8 (url) 830(defun nnrss-find-rss-via-syndic8 (url)
689 "query syndic8 for the rss feeds it has for the url." 831 "Query syndic8 for the rss feeds it has for URL."
690 (if (not (locate-library "xml-rpc")) 832 (if (not (locate-library "xml-rpc"))
691 (progn 833 (progn
692 (message "XML-RPC is not available... not checking Syndic8.") 834 (message "XML-RPC is not available... not checking Syndic8.")
@@ -697,22 +839,22 @@ whether they are `offsite' or `onsite'."
697 'syndic8.FindSites 839 'syndic8.FindSites
698 url))) 840 url)))
699 (when feedid 841 (when feedid
700 (let* ((feedinfo (xml-rpc-method-call 842 (let* ((feedinfo (xml-rpc-method-call
701 "http://www.syndic8.com/xmlrpc.php" 843 "http://www.syndic8.com/xmlrpc.php"
702 'syndic8.GetFeedInfo 844 'syndic8.GetFeedInfo
703 feedid)) 845 feedid))
704 (urllist 846 (urllist
705 (delq nil 847 (delq nil
706 (mapcar 848 (mapcar
707 (lambda (listinfo) 849 (lambda (listinfo)
708 (if (string-equal 850 (if (string-equal
709 (cdr (assoc "status" listinfo)) 851 (cdr (assoc "status" listinfo))
710 "Syndicated") 852 "Syndicated")
711 (cons 853 (cons
712 (cdr (assoc "sitename" listinfo)) 854 (cdr (assoc "sitename" listinfo))
713 (list 855 (list
714 (cons 'title 856 (cons 'title
715 (cdr (assoc 857 (cdr (assoc
716 "sitename" listinfo))) 858 "sitename" listinfo)))
717 (cons 'href 859 (cons 'href
718 (cdr (assoc 860 (cdr (assoc
@@ -721,20 +863,20 @@ whether they are `offsite' or `onsite'."
721 (if (not (> (length urllist) 1)) 863 (if (not (> (length urllist) 1))
722 (cdar urllist) 864 (cdar urllist)
723 (let ((completion-ignore-case t) 865 (let ((completion-ignore-case t)
724 (selection 866 (selection
725 (mapcar (lambda (listinfo) 867 (mapcar (lambda (listinfo)
726 (cons (cdr (assoc "sitename" listinfo)) 868 (cons (cdr (assoc "sitename" listinfo))
727 (string-to-int 869 (string-to-int
728 (cdr (assoc "feedid" listinfo))))) 870 (cdr (assoc "feedid" listinfo)))))
729 feedinfo))) 871 feedinfo)))
730 (cdr (assoc 872 (cdr (assoc
731 (completing-read 873 (completing-read
732 "Multiple feeds found. Select one: " 874 "Multiple feeds found. Select one: "
733 selection nil t) urllist))))))))) 875 selection nil t) urllist)))))))))
734 876
735(defun nnrss-rss-p (data) 877(defun nnrss-rss-p (data)
736 "Test if data is an RSS feed. Simply ensures that the first 878 "Test if DATA is an RSS feed.
737element is rss or rdf." 879Simply ensures that the first element is rss or rdf."
738 (or (eq (caar data) 'rss) 880 (or (eq (caar data) 'rss)
739 (eq (caar data) 'rdf:RDF))) 881 (eq (caar data) 'rdf:RDF)))
740 882
@@ -755,13 +897,13 @@ element is rss or rdf."
755that gives the URI for which you want to retrieve the namespace 897that gives the URI for which you want to retrieve the namespace
756prefix), return the prefix." 898prefix), return the prefix."
757 (let* ((prefix (car (rassoc uri (cadar el)))) 899 (let* ((prefix (car (rassoc uri (cadar el))))
758 (nslist (if prefix 900 (nslist (if prefix
759 (split-string (symbol-name prefix) ":"))) 901 (split-string (symbol-name prefix) ":")))
760 (ns (cond ((eq (length nslist) 1) ; no prefix given 902 (ns (cond ((eq (length nslist) 1) ; no prefix given
761 "") 903 "")
762 ((eq (length nslist) 2) ; extract prefix 904 ((eq (length nslist) 2) ; extract prefix
763 (cadr nslist))))) 905 (cadr nslist)))))
764 (if (and ns (not (eq ns ""))) 906 (if (and ns (not (string= ns "")))
765 (concat ns ":") 907 (concat ns ":")
766 ns))) 908 ns)))
767 909
diff --git a/man/ChangeLog b/man/ChangeLog
index f5fac8398f6..bd8aa59918d 100644
--- a/man/ChangeLog
+++ b/man/ChangeLog
@@ -1,3 +1,7 @@
12005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus.texi (RSS): Addition.
4
12005-04-09 Luc Teirlinck <teirllm@auburn.edu> 52005-04-09 Luc Teirlinck <teirllm@auburn.edu>
2 6
3 * display.texi (Useless Whitespace): `indicate-unused-lines' is 7 * display.texi (Useless Whitespace): `indicate-unused-lines' is
diff --git a/man/gnus.texi b/man/gnus.texi
index c670da11b22..6345cc2a18b 100644
--- a/man/gnus.texi
+++ b/man/gnus.texi
@@ -15873,14 +15873,45 @@ changes to a wiki (e.g. @url{http://cliki.net/recent-changes.rdf}).
15873@acronym{RSS} has a quite regular and nice interface, and it's 15873@acronym{RSS} has a quite regular and nice interface, and it's
15874possible to get the information Gnus needs to keep groups updated. 15874possible to get the information Gnus needs to keep groups updated.
15875 15875
15876Note: you had better use Emacs which supports the @code{utf-8} coding
15877system because @acronym{RSS} uses UTF-8 for encoding non-@acronym{ASCII}
15878text by default. It is also used by default for non-@acronym{ASCII}
15879group names.
15880
15876@kindex G R (Summary) 15881@kindex G R (Summary)
15877Use @kbd{G R} from the summary buffer to subscribe to a feed---you 15882Use @kbd{G R} from the summary buffer to subscribe to a feed---you will
15878will be prompted for the location of the feed. 15883be prompted for the location, the title and the description of the feed.
15884The title, which allows any characters, will be used for the group name
15885and the name of the group data file. The description can be omitted.
15879 15886
15880An easy way to get started with @code{nnrss} is to say something like 15887An easy way to get started with @code{nnrss} is to say something like
15881the following in the group buffer: @kbd{B nnrss RET RET y}, then 15888the following in the group buffer: @kbd{B nnrss RET RET y}, then
15882subscribe to groups. 15889subscribe to groups.
15883 15890
15891The @code{nnrss} back end saves the group data file in
15892@code{nnrss-directory} (see below) for each @code{nnrss} group. File
15893names containing non-@acronym{ASCII} characters will be encoded by the
15894coding system specified with the @code{nnmail-pathname-coding-system}
15895variable. If it is @code{nil}, in Emacs the coding system defaults to
15896the value of @code{default-file-name-coding-system}. If you are using
15897XEmacs and want to use non-@acronym{ASCII} group names, you should set
15898the value for the @code{nnmail-pathname-coding-system} variable properly.
15899
15900@cindex OPML
15901You can also use the following commands to import and export your
15902subscriptions from a file in @acronym{OPML} format (Outline Processor
15903Markup Language).
15904
15905@defun nnrss-opml-import file
15906Prompt for an @acronym{OPML} file, and subscribe to each feed in the
15907file.
15908@end defun
15909
15910@defun nnrss-opml-export
15911Write your current @acronym{RSS} subscriptions to a buffer in
15912@acronym{OPML} format.
15913@end defun
15914
15884The following @code{nnrss} variables can be altered: 15915The following @code{nnrss} variables can be altered:
15885 15916
15886@table @code 15917@table @code
@@ -15889,6 +15920,13 @@ The following @code{nnrss} variables can be altered:
15889The directory where @code{nnrss} stores its files. The default is 15920The directory where @code{nnrss} stores its files. The default is
15890@file{~/News/rss/}. 15921@file{~/News/rss/}.
15891 15922
15923@item nnrss-file-coding-system
15924@vindex nnrss-file-coding-system
15925The coding system used when reading and writing the @code{nnrss} groups
15926data files. The default is the value of
15927@code{mm-universal-coding-system} (which defaults to @code{emacs-mule}
15928in Emacs or @code{escape-quoted} in XEmacs).
15929
15892@item nnrss-use-local 15930@item nnrss-use-local
15893@vindex nnrss-use-local 15931@vindex nnrss-use-local
15894@findex nnrss-generate-download-script 15932@findex nnrss-generate-download-script